Matching two columns and copying the corresponding rows to a new sheet

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