Leerzeilen einfügen

[Mario0366]

Hallo zusammen,

ich habe ein Arbeitsblatt "Abrechnung". Hier möchte ich gerne vor jeder Zelle in Spalte A (ab A3), die einen Wert enthält, drei leere Zeilen einfügen.
Hierzu habe ich den folgenden VBA Code geschrieben. Leider funktioniert dieser nur bis zur Zeile 106. Die nächste Zelle mit einem Wert in Zeile  115 findet er nicht mehr.
Es wäre super, wenn Ihr helfen könntet.

Code:

Function IsReallyEmpty(rng As Range) As Boolean
    IsReallyEmpty = rng.Value = "" And rng.Text = ""
End Function

Code:

Sub LeereZeilenEinfuegen()
    ' Variable deklarieren
    Dim i As Long
    ' Verweist auf das Arbeitsblatt "Abrechnung".
    With Worksheets("Abrechnung")
        ' Durchläuft alle Zeilen in Spalte A, beginnend mit Zeile 4
        For i = 4 To .UsedRange.Rows.Count
            ' Überprüft ob die aktuelle Zelle in Spalte A nicht leer ist
            If Not IsReallyEmpty(.Cells(i, "A")) Then
                ' Fügt 3 leere Zeilen über der aktuellen befüllten Zeile
                .Rows(i).Resize(3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = i + 4
            End If
        Next i
    End With
End Sub

Danke und einen schönen Tag wünsche ich Euch.

Viele Grüße Mario

[snb]

Auf verbundene Zellen, leere Spalten und leere Zeilen zwischen Daten sollte man in Excel verzichten.

[Gast 123]

Hallo

ich möchte snb nicht wiedersprechen.  Wenn es aber erforderlich ist aendere den Code bitte so:
Begründung:  Einfügen von Zeilen funktioniert nur mit einer Rückwärts For Next Schleife einwandfrei (Step -1)
Bedenke bitte, dein UsedRange Bereich verändert sich beim einfügen, beim Start von For Next wurde er festgelegt!
Die Änderung bekommt For Next nicht mit! Da beissen sich Katz und Hund, weil die LastZell durch das einfügen nicht mehr stimmt!

mfg Gast 123

Code:

        For i = .UsedRange.Rows.Count To 4 Step -1
            ' Überprüft ob die aktuelle Zelle in Spalte A nicht leer ist
            If .Cells(i, "A").Value = Empty Then
                ' Fügt 3 leere Zeilen über der aktuellen befüllten Zeile
                .Rows(i).Resize(3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = i + 4
            End If
        Next i