Leerzeilen ausblenden

Sub Ausblenden()
Dim Bereich As String, lo As String, ru As String, aC As String
Dim zo As Long, zu As Long, i As Long
Dim sl As Integer, sr As Integer
Application.ScreenUpdating = False
aC = ActiveCell.Address
Application.Goto Reference:="Print_Area"
Bereich = Selection.Address(False, False)
lo = Left(Bereich, InStr(Bereich, ":") - 1)             'links oben
ru = Right(Bereich, Len(Bereich) - InStr(Bereich, ":")) 'rechts unten
zo = Range(lo).Row                                      'Zeile oben
zu = Range(ru).Row                                      'Zeile unten
sl = Range(lo).Column                                   'Spalte links
sr = Range(ru).Column                                   'Spalte rechts
For i = zo To zu
If WorksheetFunction.CountBlank(Range(Cells(i, sl), Cells(i, sr))) = sr - sl + 1 Then
Rows(i & ":" & i).EntireRow.Hidden = True
End If
Next i
Range(aC).Select
Application.ScreenUpdating = True
End Sub