Sub run()

    Dim row As Integer, sheet2Row As Integer
    row = 2

    With Sheet1
        Do While (.Cells(row, 1) <> "")
            sheet2Row = findInSheet2(.Cells(row, 1))
            If sheet2Row <> 0 Then copyRow (sheet2Row)
            row = row + 1
        Loop
    End With

End Sub

Function findInSheet2(text As String) As Integer

    Dim found As Range

    With Sheet2
        Set found = .Columns(1).Find(What:=text, MatchCase:=True)
        If Not found Is Nothing Then
            findInSheet2 = found.row
        Else
            findInSheet2 = 0
        End If
    End With

End Function

Sub copyRow(row As Integer)

    Sheet2.Rows(row).Copy
    Sheet3.Rows(getSheet3LastRow).PasteSpecial

End Sub

Function getSheet3LastRow()

    Dim found As Range

    Set found = Sheet3.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not found Is Nothing Then
        getSheet3LastRow = found.row + 1
    Else
        getSheet3LastRow = 1
    End If

End Function

Sub run()

    Dim row As Integer, sheet2Row As Integer
    row = 2

    With Sheet1
        Do While (.Cells(row, 1) <> "")
            sheet2Row = findInSheet2(.Cells(row, 1))
            If sheet2Row <> 0 Then copyRow (sheet2Row)
            row = row + 1
        Loop
    End With

End Sub

Function findInSheet2(text As String) As Integer

    Dim found As Range

    With Sheet2
        Set found = .Columns(1).Find(What:=text, MatchCase:=True)
        If Not found Is Nothing Then
            findInSheet2 = found.row
        Else
            findInSheet2 = 0
        End If
    End With

End Function

Sub copyRow(row As Integer)

    Sheet2.Rows(row).Copy
    Sheet3.Rows(getSheet3LastRow).PasteSpecial

End Sub

Function getSheet3LastRow()

    Dim found As Range

    Set found = Sheet3.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not found Is Nothing Then
        getSheet3LastRow = found.row + 1
    Else
        getSheet3LastRow = 1
    End If

End Function

Sub run()

    Dim row As Integer, sheet2Row As Integer
    row = 2

    With Sheet1
        Do While (.Cells(row, 1) <> "")
            sheet2Row = findInSheet2(.Cells(row, 1))
            If sheet2Row <> 0 Then copyRow (sheet2Row)
            row = row + 1
        Loop
    End With

End Sub

Function findInSheet2(text As String) As Integer

    Dim found As Range

    With Sheet2
        Set found = .Columns(1).Find(What:=text, MatchCase:=True)
        If Not found Is Nothing Then
            findInSheet2 = found.row
        Else
            findInSheet2 = 0
        End If
    End With

End Function

Sub copyRow(row As Integer)

    Sheet2.Rows(row).Copy
    Sheet3.Rows(getSheet3LastRow).PasteSpecial

End Sub

Function getSheet3LastRow()

    Dim found As Range

    Set found = Sheet3.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not found Is Nothing Then
        getSheet3LastRow = found.row + 1
    Else
        getSheet3LastRow = 1
    End If

End Function

Sub run()

    Dim row As Integer, sheet2Row As Integer
    row = 2

    With Sheet1
        Do While (.Cells(row, 1) <> "")
            sheet2Row = findInSheet2(.Cells(row, 1))
            If sheet2Row <> 0 Then copyRow (sheet2Row)
            row = row + 1
        Loop
    End With

End Sub

Function findInSheet2(text As String) As Integer

    Dim found As Range

    With Sheet2
        Set found = .Columns(1).Find(What:=text, MatchCase:=True)
        If Not found Is Nothing Then
            findInSheet2 = found.row
        Else
            findInSheet2 = 0
        End If
    End With

End Function

Sub copyRow(row As Integer)

    Sheet2.Rows(row).Copy
    Sheet3.Rows(getSheet3LastRow).PasteSpecial

End Sub

Function getSheet3LastRow()

    Dim found As Range

    Set found = Sheet3.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not found Is Nothing Then
        getSheet3LastRow = found.row + 1
    Else
        getSheet3LastRow = 1
    End If

End Function