Sub ZeilenEinfuegen()
Dim Ende As Long
Dim L As Long
Ende = Range("A65536").End(xlUp).Row
For L = Ende To 1 Step -1
Range(Cells(L, 1), Cells(L + 2, 1)).EntireRow.Insert shift:=xlDown
Next L
End Sub
Klappt es?
Gruß
Uwe
(:o)
Public Sub ZeilenEinfuegen()
Application.ScreenUpdating = False
Range("A1").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value "" Then
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(3, 0).Select
End If
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
End Sub
Deine Variante klappt aber auch prima. :-)
Torsten
Sub ZeilenKopiernUndEinfügen()
Dim Ende As Long
Dim L As Long
Ende = Range("A65536").End(xlUp).Row
For L = Ende To 1 Step -1
Rows(L).Copy
Rows(L & ":" & L + 2).Insert shift:=xlDown
Application.CutCopyMode = False
Next L
End Sub
Gruß
Uwe
(:o)
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen