Sub CEL4()
    Application.ScreenUpdating = False

Dim List_1 As Range
Dim List_2 As Range

For Each List_1 In ActiveWorkbook.Worksheets( 1 ).Range("A:A")
    If List_1.Value <> "" Then
Set List_2 = ActiveWorkbook.Worksheets( 2 ).Range("A:A").Find(What:=List_1, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
        If Not List_2 Is Nothing Then
            Application.EnableEvents = False
            List_2.EntireRow.Copy List_1
            Application.EnableEvents = True
        End If
    End If
Next List_1

    Application.ScreenUpdating = True
End Sub

            List_2.EntireRow.Copy List_1

List_2.Worksheet.Range("A" & List_2.Row & ":B" & List_2.Row).Copy List_1.Worksheet.Range("H" & List_1.Row & ":I" & List_1.Row)