Hello Ossie

works great is there a way to copy only certain columns in those rows. like
A G H

"OssieMac" wrote:

Hi again Jhyatt,

That explains that it was some sample code that you want to modify. In case
you need some further help, I have modified the code to copy the entire row
of the found data to a another worksheet named "Trade List". The code will
skip finding in the "Trade List" worksheet.

If you do not have column headers on the "Trades List" worksheet then you
will see that the code will leave a row blank at the top. That is just the
way the Destination code works with the End(xlUp).Offset(1,0).

Feel free to get back to me again if you need any further help.

Public Sub AddName(ByVal Fruit As String)
Dim wks As Worksheet 'Each worksheet in workbook
Dim wsList As Worksheet 'Worksheet with list
Dim rngToSearch As Range
Dim rngFound As Range
Dim strFirstAddress As String

'Edit to your worksheet name
Set wsList = Sheets("Trade List")
'Repeat for each worksheet in workbook
For Each wks In Worksheets
If wks.Name < wsList.Name Then
Set rngToSearch = wks.Columns("A")

Set rngFound = rngToSearch.Find(What:=Fruit, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Do
'Copy entire row of record to new location
rngFound.EntireRow.Copy _
Destination:=wsList.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
End If

End If
Next wks

End Sub

Regards,

OssieMac