Suchen

Sub mehrfacheSuche()
Dim rngSearch As Range
Dim strSearch As String, strFirst As String
strSearch = InputBox("Suchbegriff:", "Suchen")
If strSearch = "" Then Exit Sub
Set rngSearch = Range("K:K").Find(what:=strSearch, LookIn:=xlFormulas, LookAt:=xlPart)
If Not rngSearch Is Nothing Then
strFirst = rngSearch.Address
Do
Application.Goto rngSearch, True
If MsgBox("Weitersuchen?", 36, "Frage") <> 6 Then Exit Sub
Set rngSearch = Range("K:K").FindNext(rngSearch)
Loop While Not rngSearch Is Nothing And rngSearch.Address <> strFirst
Else
MsgBox "Nichts gefunden", 64, "Hinweis"
End If
End Sub