Combine Two Worksheets

[Evan_Robitaille via OfficeKB.com]

I have two files with the following columns:

FILE 1 FILE 2
A: User ID A: End User
B: First Name B: Name
C: Last Name C: SSN
D: Active User
E: Payment
F: Payment Total
G: Last Payment Date

The common field is Column A in both tables. I want to start with File 2 and
bring the contents of Column E in File 1 into File 2. My new file would then
be:
A: End User
B: Name
C: SSN
D: Payment (field inserted from File 1)

Thanks in advance for any help with this.

 

[Per Jessen]

Hi

Insert the code in "File2", and change file / sheet names as required.

Sub Combine()
Dim wbA As Workbook
Dim wbB As Workbook
Dim shA As Worksheet
Dim shB As Worksheet

Set wbA = ThisWorkbook
Set wbB = Workbooks("File1.xls") 'Change name to suit
Set shA = wbA.Worksheets("Sheet1")
Set shB = wbB.Worksheets("Sheet1")

LastRow = shA.Range("A1").End(xlDown).Row

For r = 2 To LastRow ' Headings in row 1
EndUser = Cells(r, 1).Value
Set f = shB.Columns("A").Find(what:=EndUser, LookAt:=xlWhole)
If Not f Is Nothing Then
shA.Cells(r, 4) = shB.Cells(f.Row, 5).Value
Set f = Nothing
End If
Next
End Sub

Regards,
Per

 

[Evan_Robitaille via OfficeKB.com]

Thanks for your help with this, worked like a charm.

Hi

Insert the code in "File2", and change file / sheet names as required.

Sub Combine()
Dim wbA As Workbook
Dim wbB As Workbook
Dim shA As Worksheet
Dim shB As Worksheet

Set wbA = ThisWorkbook
Set wbB = Workbooks("File1.xls") 'Change name to suit
Set shA = wbA.Worksheets("Sheet1")
Set shB = wbB.Worksheets("Sheet1")

LastRow = shA.Range("A1").End(xlDown).Row

For r = 2 To LastRow ' Headings in row 1
EndUser = Cells(r, 1).Value
Set f = shB.Columns("A").Find(what:=EndUser, LookAt:=xlWhole)
If Not f Is Nothing Then
shA.Cells(r, 4) = shB.Cells(f.Row, 5).Value
Set f = Nothing
End If
Next
End Sub

Regards,
Per

I have two files with the following columns:

[quoted text clipped - 19 lines]