Gruß Achim
Sub suchen()
Dim Zelle As Range
Dim Begriff As Variant
Dim firstaddress As String
Dim z As Long
Range("A2").Select
Begriff = InputBox("Suchbegriff, oder Teil davon eingeben")
If Begriff = "" Then Exit Sub
With Worksheets("Kundenliste").Range("A1:G201")
Set Zelle = Cells.Find(Begriff, LookAt:=xlPart, LookIn:=xlValues)
If Not Zelle Is Nothing Then
firstaddress = Zelle.Address
Do
Zelle.Interior.ColorIndex = 3
Rem Application.Wait Now + TimeValue("00:00:02") ' nach 2 sec. wird die zelle wieder weiß
Rem c.Interior.ColorIndex = 0
z = z + 1
Meldung = MsgBox("Gefunden in Zelle " & Chr$(13) & "" & Zelle.Address(False, False) & "" & Chr$(13) & "Weitersuchen ?", 32 + 4, "SUCHEN nach Vorgabe des Bereichs")
If Meldung = vbNo Then
Exit Sub
End If
Zelle.Interior.ColorIndex = 0
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> firstaddress
End If
End With
If z = 0 Then
Meldung = MsgBox(Begriff & Chr$(13) & "wurde nicht gefunden!", 64, "SUCHEN nach Vorgabe des Bereichs")
Else
Meldung = MsgBox(Begriff & Chr$(13) & "Das waren alle", 64, "SUCHEN nach Vorgabe des Bereichs")
End If
End Sub