Dringende Hilfe!!

Sub Leerzeilenlöschen()
'   Leerzeilen löschen einschließlich der Zeilen die entstehen wenn Zeilen am ende
'   gelöscht werden, auch Leerzeilen in der Tabelle werden gelöscht
'   von Wolf.W.Radzinski
On Error Resume Next
Dim r As Range
Dim anz As Long
Dim c_ges As Long
Dim col As New Collection
c_ges = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
For Each r In ActiveSheet.UsedRange.EntireRow
anz = 0
anz = r.SpecialCells(xlCellTypeBlanks).Count
If anz >= c_ges Then col.Add r
Next
For Each r In col
r.Delete
Next
End Sub