Leerzeilen per VBA löschen

[tho1jan]

Hallo zusammen,

der nachstehende Code löscht Leerzeilen zwischen den Wörtern in einer Zelle. Leider nicht Leerzeile(n) nach Wörtern. Kann da jemand helfen? Danke im voraus. Grüße Thomas

Bsp 1)
Hallo
Leerzeile
Moin
=
Hallo
Moin

Bsp 2)
Hallo
Leerzeile
Moin
Leerzeile
=
Hallo
Moin
Leerzeile

--------------------------------------------------------------------------------------------------------
Sub Leerzeilen_loeschen()
    '   alle Leerzeilen löschen
    Dim LoI As Long
    Dim RaZeile As Range
    Application.ScreenUpdating = False
    For LoI = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
        If Application.WorksheetFunction.CountA(Rows(LoI)) <> ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column Then
            If Rows(LoI).SpecialCells(xlCellTypeBlanks).Count = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column Then
                If RaZeile Is Nothing Then
                    Set RaZeile = Rows(LoI)
                Else
                    Set RaZeile = Union(RaZeile, Rows(LoI))
                End If
            End If
        End If
    Next LoI
    If Not RaZeile Is Nothing Then RaZeile.Delete
    Application.ScreenUpdating = True
    Set RaZeile = Nothing
End Sub