Hier die Formel
Sub suchen()
Dim Tabelle As Worksheet
Dim GZelle As Range
Dim FStelle$
Dim SBegriff
Dim blatt
blatt = Application.ActiveSheet.Name
SBegriff = "*" & InputBox("Bitte Suchbegriff eingeben:", "von Figuren bis Puzzle:")
'**********Abbbruch*******
If SBegriff = False Then
MsgBox "Eingabe wurde abgebrochen!"
ThisWorkbook.Sheets(blatt).Activate
Exit Sub
End If
If SBegriff = "**" Then
MsgBox "Es wurde nichts eingeschrieben oder abgebrochen!"
Exit Sub
End If
'*********Abbruch ende*****
For Each Tabelle In Worksheets
Tabelle.Activate
Set GZelle = Tabelle.Cells.Find(SBegriff)
If Not GZelle Is Nothing Then
FStelle = GZelle.Address
Do
GZelle.Activate
If MsgBox("Weitersuchen?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Set GZelle = Cells.FindNext(After:=ActiveCell)
If GZelle.Address = FStelle Then Exit Do
Loop
End If
Next Tabelle
ThisWorkbook.Sheets(blatt).Activate
MsgBox "Suche beendet - keine weiteren Einträge gefunden !"
End Sub
Vielen Dank im Vorraus