Help with my VBA
Jim,
Thanks for the assistance, your idea works and it will do for now. However
I was trying to come up with something that I do not have to type in, I tried
a few other things all with no much success but your idea does work but will
have to change every time I get a new list of names.
Thanks
"Jim Thomlinson" wrote:
The easiest thing to do is to add a parameter to the procedure which is the
name you are looking for. Then call the procedure repeatedly with different
names...
Sub CopyAllNames
call Sub CopyNames("James")
call Sub CopyNames("John")
end sub
public sub CopyNames(byval strName as string)
'...
If Cells(sRow, "A") Like "*" & strname & "*" Then
'...
end sub
--
HTH...
Jim Thomlinson
"James" wrote:
I have the following code and what it does is find the name "James" in this
example and copies all the information that is associated on that row and
places it on Sheet2.
I need this code to be a little more flexiable, but cannot figure out how to
have it look through a list of names that is on Sheet3 in column A starting
in row1. I will have anywhere between 10 to 20 names and would like this
Macro to run through that list of names that is on Sheet3. I hope I have
explained this well enough, if not let me know
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 "*James*" 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
Thank you, as always
|