J
James
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
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