I want to copy a row based on the values from another sheet

Question

I'm trying to write a macro that will copy the entire row from sheet 1 to sheet3 if it has the values of sheet2.

For example, if I have the below contents in sheet1 and sheet2

Sheet 1     Sheet 2   
Name DOJ    Name        
abc  123    def          
def  456    jkl          
ghi  789
jkl  101

then I need the output as below in sheet3

Name  DoJ
def  456
Jkl  101

Please include the code you are "trying to write", and tell us what isn't working, then we will be able to help you. (And possibly explain why you can't just do a VLOOKUP.) — YowE3K
I think my edit "collided" with your edit and it therefore rejected yours. Feel free to rollback past my edit and reapply yours if you want to. — YowE3K

Fadi Fadi · Accepted Answer · 2017-03-17T11:20:10

Try this code:

Sub Test()

 Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
 Dim Sr As Long, Lr1 As Long, Lr2 As Long, Lr3 As Long
 Dim i As Long
 Dim Rng As Range, fRng As Range

 Set Sh1 = Sheets("sheet1")
 Set Sh2 = Sheets("sheet2")
 Set Sh3 = Sheets("sheet3")

 Sr = 2
 Lr1 = Sh1.Range("A" & Sh1.Rows.Count).End(xlUp).Row
 Lr2 = Sh2.Range("A" & Sh2.Rows.Count).End(xlUp).Row
 Lr3 = Sh3.Range("A" & Sh3.Rows.Count).End(xlUp).Row + 1
 Set Rng = Sh1.Range("A" & Sr & ":A" & Lr1)

 For i = Sr To Lr2
  Set fRng = Rng.Find(Sh2.Range("A" & i).Value, , xlValues, xlWhole, xlByRows, xlNext)
  If Not fRng Is Nothing Then
   Sh3.Range("A" & Lr3 & ":B" & Lr3).Value = Sh1.Range("A" & fRng.Row & ":B" & fRng.Row).Value
   Lr3 = Lr3 + 1
  End If
 Next

End Sub

I want to copy a row based on the values from another sheet

1 Answers