How do I use excel VBA to extract rows of data from one file to another?

[Jonnywalker]

Hello all! I have a trouble writing VBA code and would appreciate any help! I would like to extract rows of data from one file(File#2) to another file( File #1) if the cell(Tag number) is matching, something like below table.



File #1

Tag Number	A	B	C
#1	data 1	data 4	data 7
#2	data 2	data 5	data 8
#3	data 3	data 6	data 9
File # 2

<colgroup><col><col span="3"></colgroup><tbody>
</tbody>

Tag Number	D	E	F
#3	data 10	Data 13	Data 16
#1	data 11	Data 14	Data 17
#2	data 12	Data 15	Data 18

<colgroup><col style="mso-width-source:userset;mso-width-alt:2998;width:62pt" width="82"> <col style="width:48pt" span="3" width="64"> </colgroup><tbody>
</tbody>

Result File #1

Tag Number	A	B	C	D	E	F
#1	data 1	data 4	data 7	data 11	Data 14	Data 17
#2	data 2	data 5	data 8	data 12	Data 15	Data 18
#3	data 3	data 6	data 9	data 10	Data 13	Data 16

<colgroup><col span="2"><col><col span="4"></colgroup><tbody>
</tbody>

any help is greatly appreciate it.

 

[Jonnywalker]

And one of the difficulties I face now is: File #2 has multiples tabsheet I would like to select, if matching, and copy to file number #1. How do I define those in VBA code?

 

[My Aswer Is This]

What is a: Tag Number?
Do you mean Row Number?

 

[Jonnywalker]

it just variables in that column. You see in that column(called tagnumbers). some of them in file #1 is matching with file #2, just different order. I would like to extract the columns in File #2 (D,E and F) into File#1 in a way that the same tag number will have the columns in File#2 accordingly.

 

[tonyyy]

You might give this a try...

Sub AppendData()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim LastColumn1 As Long
Dim LastColumn2 As Long
Dim rng1 As Range
Dim rng2 As Range
Dim r1 As Range
Dim r2 As Range

Set wb1 = Workbooks("File1.xlsx")
Set wb2 = worksooks("File2.xlsx")
LastRow1 = Cells(Rows.Count, "A").End(xlUp).Row
rng1 = wb1.Sheets(1).Range("A1:A" & LastRow1)

For Each ws In wb2.Worksheets
    LastRow2 = Cells(Rows.Count, "A").End(xlUp).Row
    rng2 = Range("A1:A" & LastRow2)
    For Each r2 In rng2
        For Each r1 In rng1
            If r1 = r2 Then
                LastColumn1 = Cells(r1.Row, Columns.Count).End(xlToLeft).Column
                LastColumn2 = Cells(r2.Row, Columns.Count).End(xlToLeft).Column
                Range(Cells(r2.Offset(0, 1)), Cells(r2.Offset(0, LastColumn2))).Copy _
                    Destination:=Range(Cells(r1.Offset(0, LastColumn1 + 1)))
            End If
        Next r1
    Next r2
Next ws

End Sub

Please note, the code is untried and untested.

Cheers,

tonyyy