View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
James James is offline
external usenet poster
 
Posts: 542
Default find and copy from a list

I need some help with this code that I was able to piece together. I am
trying to get it to look at a list on Sheet 1 all names are in column A and
search for those names on my data source worksheet, from there I would like
to get it to copy the data onto worksheet 2.

I have managed to get it to search on an indivdual name just fine but I am
having a hard time to get it to search with my list that is on Sheet1.
My workbook is set up like this
Sheet1 - Has the list of names that I want to search for
Sheet2 - DestSheet (where the data is copied to)
Sheet3 - Has all the data

Below is my code:

Sub CopyAllNames()
Dim rng As Range
Dim rngNames As Range

With Sheets("Sheet1")
Set rngNames = .Range(.Range("A1"), .Cells(Rows.Count, "A").End(xlUp))
End With
For Each rng In rngNames
Call CopyNames(rng.Value)
End Sub


Public Sub CopyNames(ByVal strName As String)
'Sub CopyNames()
'col Name of the active worksheet (source sheet) to cols
'A to Z of Sheet2 (destination sheet)
Dim DestSheet As Worksheet
Set DestSheet = Worksheets("Sheet2")

Dim sRow As Long 'row index on source worksheet
Dim dRow As Long 'row index on destination worksheet
Dim sCount As Long


sCount = 0
dRow = 1

For sRow = 1 To Range("D65536").End(xlUp).Row
'use pattern matching to find "Name" anywhere in cell

If Cells(sRow, "A") Like "*" & strName & "*" Then

'If Cells(sRow, "A") Like "*Pena*" Then
sCount = sCount + 1
dRow = dRow + 1
'copy cols A to Z
Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A")
Cells(sRow, "B").Copy Destination:=DestSheet.Cells(dRow, "B")
Cells(sRow, "C").Copy Destination:=DestSheet.Cells(dRow, "C")
Cells(sRow, "D").Copy Destination:=DestSheet.Cells(dRow, "D")
Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "F")
Cells(sRow, "G").Copy Destination:=DestSheet.Cells(dRow, "G")
Cells(sRow, "H").Copy Destination:=DestSheet.Cells(dRow, "H")
Cells(sRow, "I").Copy Destination:=DestSheet.Cells(dRow, "I")
End If
Next sRow

MsgBox sCount & " rows copied", vbInformation, "Transfer Done"

End Sub

Thanks for the help