Egyszerű kereső

Sziasztok! Szia Imre!

Segítséget szeretnék kérni, egy kis kereső rutin kódjával kapcsolatban. Kicsit elakadtam.
A lényeg, hogy az alábbi rutin egy inputbox-ban bekért szövegrészt megkeres az egész munkafüzetben, majd kiírja a a talált cellák címét az A oszlop usedrange alatti cellákba (kb olyasmit szeretnék mint a CTRL + F All Find beépített funkció) viszont végtelen ciklusba megy, ami teljesen egyértelmű, de nem tudom, hogyan lehetne elérni, hogy kilépjen a ciklusból, ha már végigment az utolsó nem üres cellán is. 🙁
Ha valaki tud segíteni előre is nagyon köszönöm.
A kód eddig:

Sub cellakereso()

Dim Sh As Worksheet
Dim keresett As Range
Range(„A1”).Select
For Each Sh In ThisWorkbook.Worksheets
With Sh.UsedRange
Set keresett = .Cells.Find(What:=InputBox(„Mit keresünk?”))
If Not keresett Is Nothing Then
Do Until keresett Is (…na ide kellene talán, hogy meddig…)
Cells(ActiveCell.CurrentRegion.Cells(ActiveCell.CurrentRegion.Cells.Count).Offset(1, 0).Row, ActiveCell.Column).Select
Selection.Value = keresett.Address
Set keresett = .FindNext(keresett)

Loop
End If
End With
Set keresett = Nothing
Next

End Sub