Möglichkeit für Scrolling

Sub Suche()
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
sFind = InputBox("Bitte Suchbegriff eingeben:")
For Each wks In Worksheets
If wks.Index > 2 Then
Set rng = wks.Cells.Find(what:=sFind, lookat:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.Goto rng, True
If MsgBox(prompt:="Zurück zur Startseite", Buttons:=vbYesNo + vbQuestion) = vbNo Then Exit Sub
Set rng = Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
End If
Next wks
MsgBox prompt:="Fertig!"
End Sub