Select a value, search in another sheet, and copy the entire row to another

[shreydas22]

Hi all,
I am new to macro so would really appreciate your help.

I am looking to create a macro which on click of a button
1) Will go to sheet 1, select the first cell value
2) find it in sheet 2 and if a match found, select the entire row
3) go to sheet 3 and paste the selected row after the last entry
4) go back to sheet one, select the next value and repeat the same step till last value is reached

Many thanks in advance
Shrey

 

[AlanSidman]

Option Explicit

Sub findncopy()
    Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
    Dim lr1 As Long, lr2 As Long, lr3 As Long
    Dim i As Long, j As Long
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    Set s3 = Sheets("Sheet3")
    Application.ScreenUpdating = False
    lr1 = s1.Range("A" & Rows.Count).End(xlUp).Row
    lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lr1
        For j = 3 To lr2
            lr3 = s3.Range("A" & Rows.Count).End(xlUp).Row + 1
            If s2.Range("A" & j) = s1.Range("A" & i) Then
                s2.Range("A" & j & ":E" & j).Copy
                s3.Range("A" & lr3).PasteSpecial xlPasteValues
            End If
        Next j
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "complete"

End Sub

 

[Marc L]

Hi !​

1) Will go to sheet 1, select the first cell value
2) find it in sheet 2 and if a match found, select the entire row
3) go to sheet 3 and paste the selected row after the last entry
4) go back to sheet one, select the next value and repeat the same step till last value is reached

Instead of copying row by row an efficient way is using some Excel basics (here an EZ formula and an advanced filter)​

like anyone can do manually - so at beginner level and respecting the TEBV main rule -​

as all matching rows can (must !) be copied at once without any loop neither selecting !​

Sub Demo()
         Application.ScreenUpdating = False
    With Sheet2.UsedRange
        .Range("K2").Formula = "=ISNUMBER(MATCH(A2,Sheet1!$A$2:$A$" & [Sheet1!A1].End(xlDown).Row & ",0))"
        .AdvancedFilter xlFilterInPlace, .Range("K1:K2")
        .Offset(1).Copy Sheet3.Cells(Rows.Count, 1).End(xlUp)(2)
     If .Parent.FilterMode Then .Parent.ShowAllData
        .Range("K2").Clear
    End With
         Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !​

​