View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Mark Cover Mark Cover is offline
external usenet poster
 
Posts: 19
Default Find all then paste not working.

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

"Tom Ogilvy" wrote:

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

--
Regards,
Tom Ogilvy


"Mark Cover" wrote in message
...
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