Sub Würg()
Dim Bereich As Range, rngF As Range, lg As Long
Rows.Hidden = False
Set Bereich = Cells(Cells.Find("*", Cells(1), -4123, 2, 1, 2, False).Row, 4).Resize(, 4)
Do
On Error Resume Next
Set rngF = Bereich.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rngF Is Nothing Then
For Each rngF In Bereich.Cells
lg = lg + Len(rngF.Value)
Next rngF
If lg = 0 Then Bereich.EntireRow.Hidden = True
Set rngF = Nothing: lg = 0: GoTo Weiter
End If
Nix:
If WorksheetFunction.CountA(Bereich) = 0 Then Bereich.EntireRow.Hidden = True
Weiter:
Set Bereich = Bereich.Offset(-1)
Loop Until Bereich.Row = 1
End Sub