Simple Find-all

[wratpack]

I cannot seem to get this macro to work. I worked once and then it progressive loops through more and more yeilding multiple repetitive finds.
It is suppose to look for the string input by the user in all sheets and past the search results into the "Summary" sheet.
Any help would be much appreaciated.

The code is below:

Private Sub CommandButton1_Click()
ScreenUpdating = False
Dim varFound As Variant, varSearch As Variant
Dim strAddress As String, ws As Worksheet
Dim lastrow As Range
varSearch = InputBox("Search string")
For Each ws In ActiveWorkbook.Sheets
ws.UsedRange.Interior.ColorIndex = 0
ws.UsedRange.Font.ColorIndex = 0
With ws.UsedRange
Set varFound = .Find(varSearch, LookIn:=xlValues)
If Not varFound Is Nothing Then
strAddress = varFound.Address
Do
varFound.EntireRow.Copy
Sheets("summary").Range("a65536").End(xlUp).Offset(1, 0).PasteSpecial
Set varFound = .FindNext(varFound)
Loop While Not varFound Is Nothing And _
varFound.Address <> strAddress
End If
End With
Next
ScreenUpdating = True
End Sub