Zeilen löschen

Sub nicht_leere_Zeilen_loeschen()
'Löscht nicht leere Zeilen
Dim c As Range
Dim Bereich As Range
Dim ErgBereich As Range
Dim laR As Long
Application.ScreenUpdating = False
laR = Cells(Rows.Count, 1).End(xlUp).Row
Set Bereich = Range("C1:C" & laR)
For Each c In Bereich
If c.Value  "" Then
Set ErgBereich = c
Exit For
End If
Next c
If ErgBereich Is Nothing Then
MsgBox "Nichts gefunden !", vbOKOnly + vbInformation, _
"Dezenter Hinweis für " & Application.UserName & ":"
Else
For Each c In Bereich
If c.Value  "" Then
Set ErgBereich = Application.Union(ErgBereich, c)
End If
Next c
ErgBereich.Select
Set ErgBereich = Nothing
Set Bereich = Nothing
End If
Application.ScreenUpdating = True
End Sub