Suchfunktion läuft nicht

Sub durchsuchen ()
frage="Was"
suche=Inputbox(frage)
if suche = "" then
exit sub
end if
With Worksheets(1).Range("B2:B2000")
Worksheets(1).select
Jetzt kommt der Fehler, wo das Macro stehen bleibt.
Set zelle=.Find(suche, LookIn:=xlValues, LookIn:=xlFormulas, lookat:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
if Not zelle=is Nothing then
ersteAdresse=zelle.Address
Do
Range(zelle.Address).interior.colorindex=6
Set zelle=.FindNext(zelle)
zelle select
Loop while Not zelle is Nothing And zelle.Address  ersteAdresse
End if
End with
End Sub