Sub Suchen()
Dim strSuche As String
Dim rngErgebnis As Range
Dim firstAddress As String
Dim strGefunden() As String
Dim intZählerGesamt As Integer
Dim intZählerEinzel As Integer

Do
    strSuche = InputBox("Mindestens die 3 ersten Buchstaben des Suchbegriffes " _
                & "oder kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen")
    If strSuche = "" Or Len(strSuche) = 0 Then Exit Sub
Loop Until Len(strSuche) > 2

Set rngErgebnis = Range("A4:IV65536").Find(what:=strSuche, lookat:=xlPart, LookIn:=xlValues, MatchCase:=False)
If rngErgebnis Is Nothing Then
    MsgBox "Suchbegriff wurde nicht gefunden! Es ist aber nicht 100% sicher, dass " _
            & "der gesuchte Begriff sich nicht in der Tabelle befindet. Überprüfen Sie " _
            & "daher bitte nochmal die Schreibweise und geben den Suchbegriff erneut ein, " _
            & "oder suchen Sie den Begriff manuell in der Tabelle.", vbInformation, "Meldung..."
Else
    firstAddress = rngErgebnis.Address
Do
    intZählerGesamt = intZählerGesamt + 1
    ReDim Preserve strGefunden(1 To intZählerGesamt)
    strGefunden(intZählerGesamt) = rngErgebnis.Address
    Set rngErgebnis = Range("A4:IV65536").FindNext(rngErgebnis)
Loop While Not rngErgebnis Is Nothing And rngErgebnis.Address <> firstAddress
Do
    intZählerEinzel = intZählerEinzel + 1
    If intZählerEinzel = intZählerGesamt Then
    End If
    Range(strGefunden(intZählerEinzel)).Select
    ActiveWindow.ScrollRow = Selection.Row
    ActiveWindow.ScrollColumn = Selection.Column
    If MsgBox(CStr(intZählerEinzel) & ". von " & CStr(intZählerGesamt) _
        & " gefundenen Übereinstimmungen des Suchbegriffes." & vbLf _
        & "Die nächste Übereinstimmung anzeigen?", vbQuestion + vbYesNo, "Meldung...") = 7 Then Exit Do
    If intZählerEinzel = intZählerGesamt Then Exit Do
Loop
End If
Set rngErgebnis = Nothing
End Sub

Rows("18:65536").Delete

Range("A18:IV65536").Clear