Try this:![]()
Sub x() Dim r As Range, r2 As Range For Each r In Sheet1.Range("B4", Sheet1.Range("B" & Rows.Count).End(xlUp)) Set r2 = Sheet2.Range("B:B").Find(What:=r.Value, lookAt:=xlWhole, MatchCase:=False) If Not r2 Is Nothing Then r.EntireRow.Copy Sheet3.Range("A" & Rows.Count).End(xlUp)(2) Set r2 = Nothing End If Next r End Sub
Bookmarks