Mehrere Reihen einfuegen

Forumthread: Mehrere Reihen einfuegen

04.06.2019 12:29:43

Lisa

Hallo zusammen,
ich moechte mein Excelsheet noch ein bisschen einfacher gestalten. Ich habe einen Button, mit dem ich einfach eine neue Reihe an meine Tabelle anfuegen kann. In einigen Situation reicht mir aber nicht eine Zeile, ich brauche mehr Zeilen. Gibt es eine Moeglichkeit in einem Feld zu definieren wie viele Zeilen man anfuegen moechte?
Das ist der Code den ich nutze:

Sub NewRow()
Dim Zeile As Long
With ActiveSheet
'Zeilennummer:
Zeile = .Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
'Kopieren:
Intersect(.Rows(Zeile - 2), .UsedRange).Copy
.Cells(Zeile, 1).PasteSpecial Paste:=xlPasteAll
Intersect(.Rows(Zeile - 1), .UsedRange).Copy
.Cells(Zeile + 1, 1).PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
End With
End Sub

Vielen Dank schonmal!
Liebe Gruesse Lisa

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Mehrere Reihen einfuegen

04.06.2019 12:45:25

Rudi
AW: Mehrere Reihen einfuegen

04.06.2019 12:53:40

Lisa
AW: Mehrere Reihen einfuegen

04.06.2019 13:11:18

Rudi

AW: Mehrere Reihen einfuegen

04.06.2019 12:45:25

Rudi

Hallo,
jetzt kopierst du die vorletzte und die letzte Zeile. Soll das so sein?
die letzte Zeile x-mal kopieren

Sub NewRow()
Dim Zeile As Long, Anzahl As Integer
Anzahl = Range("A1")  'anpassen
Application.ScreenUpdating = False
With ActiveSheet
'Zeilennummer:
Zeile = .Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
'Kopieren:
Intersect(.Rows(Zeile - 1), .UsedRange).Copy Cells(Zeile, 1).Resize(Anzahl)
End With
End Sub

Gruß
Rudi

AW: Mehrere Reihen einfuegen

04.06.2019 12:53:40

Lisa

Hallo Rudi,
Danke fuer die Antwort. Ja in diesem speziellen Fall sollen immer die letzten 2 Zeilen kopiert werden. Der Code funktioniert leider nicht. Es zeigt mir ein Problem mit dieser Zeile:
Anzahl = Range("A1") 'anpassen

AW: Mehrere Reihen einfuegen

04.06.2019 13:11:18

Rudi

versuch mal das:

Sub NewRow()
Dim Zeile As Long, Anzahl As Integer
Anzahl = Application.InputBox(prompt:="wie oft kopieren?", Type:=1)
If Anzahl > 0 Then
Application.ScreenUpdating = False
With ActiveSheet
'Zeilennummer:
Zeile = .Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
'Kopieren:
Intersect(.Rows(Zeile - 2).Resize(2), .UsedRange).Copy Cells(Zeile, 1).Resize(Anzahl * 2)
End With
End If
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Forumthread: Mehrere Reihen einfuegen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread