Excel Macros for Find & Copy ----(Urgent HELP)

[MaxExcel]

Does any one know already had done so in the past to have a Macro in Excel to search a column of accounts from workbook1 in many other workbooks.

Example:

Workbook1> Sheet1>Column1 has many account#.

Workbook2> Sheet1, Sheet2, Sheet3 > Column1 also as account# & Column2 has Name of the the client's

What i want to do is for each account# on workbook1, search in all the worksheets in workbook2 for and copy the name of the client on column 2 and paste in workbook1 IF FOUND. if not found skip, leave it blank and continue to search for the next account#.

Previously, i have something very similar to this and i have to give credit to Datsmart for providing the below codes in solving the above problem.
_______________________________________________________________
Sub CopyFromRigCount()
Dim RngS As Range
Dim RngT As Range
Dim SrngCell As Range
Dim TrngCell As Range
Dim SSheet As String
Dim TSheet As String
'Set Source variables
SFileN = "book2.xls"
SSheet = "Sheet1"
SSheet2 = "Sheet2"
'Set Target variables
TFileN = ActiveWorkbook.Name
TSheet = "Sheet1"
'Set Source and Target Ranges to compare
Set RngS = Workbooks(SFileN).Sheets(SSheet).Range("A2:A" & Workbooks(SFileN).Sheets(SSheet).Range("A65536").End(xlUp).Row)
Set RngS2 = Workbooks(SFileN).Sheets(SSheet2).Range("A2:A" & Workbooks(SFileN).Sheets(SSheet2).Range("A65536").End(xlUp).Row)
Set RngT = Workbooks(TFileN).Sheets(TSheet).Range("A2:A" & Workbooks(TFileN).Sheets(TSheet).Range("A65536").End(xlUp).Row)
'Copy matching rows from Target to Source
For Each TrngCell In RngT
For Each SrngCell In RngS
If SrngCell = TrngCell Then
x = SrngCell.Row
xz = TrngCell.Row
Workbooks(SFileN).Sheets(SSheet).Range("B" & x).copy Workbooks(TFileN).Sheets(TSheet).Cells(xz, "B")
Workbooks(SFileN).Sheets(SSheet).Range("C" & x).copy Workbooks(TFileN).Sheets(TSheet).Cells(xz, "C")
Workbooks(SFileN).Sheets(SSheet).Range("D" & x).copy Workbooks(TFileN).Sheets(TSheet).Cells(xz, "D")
Workbooks(SFileN).Sheets(SSheet).Range("E" & x).copy Workbooks(TFileN).Sheets(TSheet).Cells(xz, "E")
Workbooks(SFileN).Sheets(SSheet).Range("F" & x).copy Workbooks(TFileN).Sheets(TSheet).Cells(xz, "F")
Workbooks(SFileN).Sheets(SSheet).Range("G" & x).copy Workbooks(TFileN).Sheets(TSheet).Cells(xz, "G")
Workbooks(SFileN).Sheets(SSheet).Range("H" & x).copy Workbooks(TFileN).Sheets(TSheet).Cells(xz, "H")
Workbooks(SFileN).Sheets(SSheet).Range("I" & x).copy Workbooks(TFileN).Sheets(TSheet).Cells(xz, "I")
End If
Next SrngCell
Next TrngCell
For Each TrngCell In RngT
For Each SrngCell In RngS2
If SrngCell = TrngCell Then
x = SrngCell.Row
xz = TrngCell.Row
Workbooks(SFileN).Sheets(SSheet2).Range("B" & x).copy Workbooks(TFileN).Sheets(TSheet).Cells(xz, "B")
End If
Next SrngCell
Next TrngCell
'Free Memory
Set RngS = Nothing
Set RngT = Nothing
Set SrngCell = Nothing
Set TrngCell = Nothing
End Sub
_________________________________________________________________

However, i need some help in modifying the above solution to solve this new issue i come across as follow:

Workbook1> Sheet1>Column1 has many account#.

Workbook2> Sheet1> Column1 also as account# & Column2 has Name of the the client'sWorkbook3> Sheet1> Column1 also as account# & Column2 has Name of the the client's
Workbook4> Sheet1> Column1 also as account# & Column2 has Name of the the client's

etc....

What i want to do is for each account# on workbook1, search in all the worksheets in workbook2/3/4... and copy the name of the client on column 2 and paste in workbook1 IF FOUND. if not found skip, leave it blank and continue to search for the next account#.

Only issue in this case is that, when there is multiple matches from workbook2/3/4.... meaning there many rows in the the workbooks has the same account # and i want to capture/copy all of the rows with the same account 3 as well to workbook1.

example:

workbook1

123456789
234567890
345678901


workbook2
123456789 joe smith address city country zipcode
123456789 joe smith1 address1 city country zipcode
123456789 joe smith2 address2 city country zipcode
234567890 lucy code address city country zipcode
345678901 marble katz address city country zipcode
345678901 marble1 katz address1 city country zipcode

wrokbook3
123456789 joe smith3 address3 city country zipcode


when i run this code workbook1 should compare with workbook2 and workbook3 and copy all teh matched results as follow:

workbook1

123456789 joe smith address city country zipcode
123456789 joe smith1 address1 city country zipcode
123456789 joe smith2 address2 city country zipcode
123456789 joe smith3 address3 city country zipcode
234567890 lucy code address city country zipcode
345678901 marble katz address city country zipcode
345678901 marble1 katz address1 city country zipcode



Thank you so much for all your help in advance!
MaxExcel

 

[AlphaFrog]

Sub CopyIDs()
    
    Dim arrIDs As Variant                       ' Array of all ID numbers to find
    Dim wbookS As Workbook                        ' Source workbooks
    Dim wsheetS As Worksheet, wsT As Worksheet      ' Source and Target worksheets
    Dim rFound As Range, sFirstfound As String
    Dim counter As Long, i As Long, bFirst As Boolean
    
    Set wsT = ThisWorkbook.Sheets("Sheet1")
    arrIDs = wsT.Range("A1", wsT.Range("A" & Rows.Count).End(xlUp)).Value
    
    Application.ScreenUpdating = False
    For i = LBound(arrIDs) To UBound(arrIDs)
        If Not IsEmpty(arrIDs(i, 1)) Then
            bFirst = True
            For Each wbookS In Workbooks
                If wbookS.Name <> ThisWorkbook.Name Then
                    For Each wsheetS In wbookS.Worksheets
                        Set rFound = wsheetS.Columns("A").Find(What:=arrIDs(i, 1), After:=wsheetS.Range("A" & Rows.Count), LookIn:=xlValues, _
                                                           LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                                           MatchCase:=False, SearchFormat:=False)
                        If Not rFound Is Nothing Then
                            sFirstfound = rFound.Address
                            Do
                                If Not bFirst Then
                                    counter = counter + 1
                                    wsT.Rows(i).Offset(counter).Insert
                                End If
                                wsT.Range("A" & i).Offset(counter).Resize(1, 10).Value = rFound.Resize(1, 10).Value
                                bFirst = False
                                Set rFound = wsheetS.Columns("A").FindNext(rFound)
                            Loop While rFound.Address <> sFirstfound
                        End If
                    Next wsheetS
                End If
            Next wbookS
        End If
    Next i
    Application.ScreenUpdating = True
    
End Sub

 

[MaxExcel]

Thank you for your quick respond AlphaFrog!

I'm not a vba savy, if you can explain to me what this code does will be a great help.

thank you again,
MaxExcel