match work sheets

[malarvel]

I have three worksheets.

In sheet1 data range A1: H19. in column A1( EMPID), column B1(NAME), C1(DESIGNATION) D1(DEPARTMENT) E1(GPF/CPF NO) F1(QUARTERS) G1(OLD BASIC
PAY) H1()GRADE PAY.

In sheet2 data range A1: G18. in column A1( EMPID), column B1(OLDBASIC), C1(BASICPAY) D1(D.A) E1(HRA) F1(T.A) G1(GROSSPAY ).

In both sheets the empid(column) is identical. i would like to match records of sheet2 with sheet1 based on empid column. If match record, I want to copy & paste entire column of (A to H) of sheet1 and corresponding (B to G) column of sheet2 in same row of sheet3.

I have a code below for process the same, but when i execute the code, In sheet3 the columns (A to H) of sheet1 will paste the first row and corresponding columns of sheet2 (B to G) will paste in next row. But I want to paste the sheet1 columns and corresponding sheet2 columns are pasted in the same row.

How to correct my code?




Sub compare()
Dim i As Long, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, x As Range
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")

With ws1
For i = 2 To .Range("A" & Rows.Count).End(3).row
Set x = ws2.Columns(1).Find(.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not x Is Nothing Then
ws3.Range("A" & Rows.Count).End(3)(2) = .Name
.Range(.Cells(i, "A"), .Cells(i, "H")).Copy ws3.Range("B" & Rows.Count).End(3)(2)
ws3.Range("A" & Rows.Count).End(3)(2) = ws2.Name
ws2.Range(ws2.Cells(x.row, "B"), ws2.Cells(x.row, "G")).Copy ws3.Range("B" & Rows.Count).End(3)(2)
End If
Set x = Nothing
Next i
End With
ws3.Cells.Columns.AutoFit

End Sub

[SamT]

I am not familiar with the syntax of .End(3) and .End(3)(2))

copy & paste [row] of (A to H) of sheet1 and corresponding (B to G) [row] of sheet2 in same row of sheet3.

Sub BAX_SamT()
Dim i As Long, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, x As Range
Dim r as Long
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")

With ws1
For i = 2 To .Range("A" & Rows.Count).End(3).row
Set x = ws2.Columns(1).Find(.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not x Is Nothing Then
r = ws3.Range("A" & Rows.Count).End(3)(2).Row

ws3.Range("A" & r) = .Name
.Range(.Cells(i, "A"), .Cells(i, "H")).Copy ws3.Range("B" & r)

ws3.Range("K" & r) = ws2.Name
ws2.Range(Cells(x.row, "B"), ws2.Cells(x.row, "G")).Copy ws3.Range("L" & r)
End If
Set x = Nothing
Next i
End With
ws3.Cells.Columns.AutoFit

End Sub