Option
Explicit
Sub
MeineSuche()
Dim
x
As
Long
, start
As
Long
Dim
SSearch
As
String
Dim
c
As
Range, fa
As
String
Dim
Flag
As
Boolean
GoOn:
SSearch = InputBox(
"Suchen nach:"
,
"Stichwort-Suche / Suchfunktion"
, SSearch)
If
SSearch =
""
Then
End
start = ActiveSheet.Index: x = start
Do
With
Sheets(x)
Set
c = .Cells.Find(SSearch, LookIn:=xlValues, MatchCase:=
False
)
If
Not
c
Is
Nothing
Then
Flag =
True
Sheets(x).Activate
fa = c.Address
Do
c.Activate
Select
Case
MsgBox(
"Weitersuchen?"
, vbQuestion + vbYesNoCancel,
""
)
Case
vbYes
Set
c = .Cells.FindNext(c)
Case
vbNo
End
Case
vbCancel
Select
Case
MsgBox(
"Neue Suche?"
, vbInformation + vbYesNo,
""
)
Case
vbYes
GoTo
GoOn
Case
vbNo
GoTo
NoGo
Case
Else
GoTo
Break
End
Select
Case
Else
GoTo
Break
End
Select
Loop
While
Not
c
Is
Nothing
And
c.Address <> fa
End
If
End
With
x = IIf(x + 1 > Sheets.Count, 1, x + 1)
If
x = ActiveSheet.Index
Then
Exit
Do
Loop
NoGo:
Sheets(start).Activate
If
Flag =
False
Then
Call
MsgBox(SSearch &
" nicht gefunden"
, vbExclamation,
""
)
If
MsgBox(
"Suche wiederholen?"
, vbInformation + vbYesNo,
""
) = vbYes
Then
GoTo
GoOn
Break:
End
Sub