find and copy from a list
Yep, I blame these things on having a senior moment. Needed .Row
It should run now. But I don't know if your variable value will carry to
the called macro or not. You can work on that.
Sub CopyAllNames()
Dim rng As Range
Dim rngNames As Range
With Sheets("Sheet1")
Set rngNames = .Range(.Range("A1"), _
..Range("A" & Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row))
End With
For Each rng In rngNames
Call CopyNames(rng.Value)
Next
End Sub
"James" wrote:
Thanks for the quick response, I saw the line wrap issue but I am still
getting an error as listed below:
Compile error:
Expected: list separator or )
I added a ")" to the end of the xlUp))
Set rngNames = .Range(.Range("A1"), .Range("A" & .Cells(Rows.Count,
"A").End(xlUp)))
But i still get an error
Run-time error '1004'
Application-defined or object-defined error
Thanks again.
"JLGWhiz" wrote:
Get rid of the line wrap.
Sub CopyAllNames()
Dim rng As Range
Dim rngNames As Range
With Sheets("Sheet1")
Set rngNames = .Range(.Range("A1"), _
.Range("A" & .Cells(Rows.Count, "A").End(xlUp))
End With
For Each rng In rngNames
Call CopyNames(rng.Value)
Next
End Sub
"James" wrote:
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
|