MsgBox bei Suche erfolglos

Sub MultiSuche()
Dim Sh As Worksheet
Dim GZelle As Range, AFarbe As Long
Dim FStelle$
Dim SBegriff
SBegriff = InputBox("Bitte Suchbegriff eingeben:")
For Each Sh In Worksheets
Sh.Activate
Set GZelle = Sh.Cells.Find(SBegriff)
If Not GZelle Is Nothing Then
FStelle = GZelle.Address
Do
If GZelle.Interior.ColorIndex  xlNone Then AFarbe = GZelle.Interior.Color
GZelle.Activate
GZelle.Interior.Color = RGB(255, 0, 0)
If MsgBox("Weiter", vbYesNo + vbQuestion) = vbNo Then
If AFarbe = 0 Then GZelle.Interior.ColorIndex = xlNone Else GZelle.Interior.Color = AFarbe
Exit Sub
End If
If AFarbe = 0 Then GZelle.Interior.ColorIndex = xlNone Else GZelle.Interior.Color = AFarbe
Set GZelle = Cells.FindNext(after:=ActiveCell)
If GZelle.Address = FStelle Then Exit Do
Loop
End If
Next Sh
End Sub