Sub FilterList()
    'Variablen
    Dim rngCurrent As Range, rngHide As Range, found As Boolean
    With ActiveSheet
        .UsedRange.EntireRow.Hidden = False
        ' Wenn Suchbegriff leer blende alle Zeilen wieder ein und beende 
        ' Prozedur
        If .Range("H2").Value = "" Then
            Exit Sub
        End If
        ' Startbereich festlegen
        Set rngCurrent = .Range("A5")
        ' so lange verarbeiten bis Bereich am Ende angelangt ist
        While rngCurrent.Address <> .Cells(Rows.Count, "A").End(xlUp).Offset( _
          1, 0).Address
            ' Wenn der Suchbegriff gefunden wurde (od. ein Teil des 
            ' Suchbegriffes)
            If rngCurrent.Value Like ("*" & .Range("H2").Value & "*") Then
                found = True
                ' prüfe ob für den Bereich Untereinträge existieren
                If rngCurrent.Offset(1, 0).Value <> "" Then
                    ' verschiebe Zeile über den aktuellen Bereich hinaus damit 
                    ' er nicht ausgeblendet wird
                    Set rngCurrent = rngCurrent.End(xlDown).Offset(1, 0)
                Else
                    ' keine Untereinträge
                    Set rngCurrent = rngCurrent.Offset(1, 0)
                End If
            Else
                ' Suchbegriff in der Zeile nicht enthalten, kombiniere den 
                ' Bereich in einer Variablen
                ' um sie später auszublenden
                If Not rngHide Is Nothing Then
                    Set rngHide = Union(rngHide, rngCurrent.EntireRow)
                Else
                    Set rngHide = rngCurrent.EntireRow
                End If
                Set rngCurrent = rngCurrent.Offset(1, 0)
            End If
        Wend
        ' Wenn der Suchbegriff gefunden wurde
        If found Then
            ' blende die nicht zutreffenden Zellen aus
            If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
        Else
            MsgBox "Kein Eintrag gefunden.", vbExclamation
        End If
    End With
End Sub