Find all then paste not working.

[Guest]

Here is the situation. I have this code and it is working fine except one
thing. I would like to paste all of the cells that are found, as it stands
now it is only finding and pasting the first instance of a word. ie. if you
search for a word that is in the ss twice it is only finding the first one.
Thanks
Code:
Private Sub cmdFind_Click()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngCopyTo As Range

Set wksCopyTo = Sheets("Search_Add")
For Each wksCopyFrom In Worksheets
If wksCopyFrom.Name <> wksCopyTo.Name And _
wksCopyFrom.Name <> "Search_Add" Then 'sheets you don't want searched
Set rngToSearch = wksCopyFrom.Cells
Set rngFound = rngToSearch.Find(txtFind.Text, , xlValues,
LookAt:=xlPart)
If Not rngFound Is Nothing Then
'If rngCopyTo.Offset.Value <> "" Then
'rngFound.Offset(1, 0).EntireRow.Insert
Set rngCopyTo = wksCopyTo.Cells(Rows.Count,
"A").End(xlUp).Offset(1, 0)
rngFound.EntireRow.Copy rngCopyTo
End If
End If
'End If
Next wksCopyFrom
txtFind.Text = ""
Sheets("Search_Add").Activate
End Sub

 

[Tom Ogilvy]

Private Sub cmdFind_Click()
Dim wksCopyFrom As Worksheet
Dim wksCopyTo As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngCopyTo As Range
Dim sAddr as String

Set wksCopyTo = Sheets("Search_Add")
For Each wksCopyFrom In Worksheets
If wksCopyFrom.Name <> wksCopyTo.Name And _
wksCopyFrom.Name <> "Search_Add" Then 'sheets you don't want
searched
Set rngToSearch = wksCopyFrom.Cells
Set rngFound = rngToSearch.Find(txtFind.Text, _
, xlValues, LookAt:=xlPart)
If Not rngFound Is Nothing Then
sAddr = rngFound.Address
do
Set rngCopyTo = wksCopyTo.Cells(Rows.Count, _
"A").End(xlUp).Offset(1, 0)
rngFound.EntireRow.Copy rngCopyTo
set rngFound = rngToSearch.FindNext(rngFound)
loop while sAddr <> rngFound.Address
End If
End If
Next wksCopyFrom
txtFind.Text = ""
Sheets("Search_Add").Activate
End Sub

 

[Guest]

Tom,
Works like a charm..
you are the man thinks so much for your help.