Sub Demo()
Application.ScreenUpdating = False
Dim xlWkSht As Worksheet, ArrData As String, StrMatch
Dim LRow As Long, i As Long, j As Long, k As Long
With ThisWorkbook
  Set xlWkSht = .Worksheets("Sheet3")
  k = xlWkSht.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
  If k = 1 Then
    With .Worksheets("Sheet2").UsedRange
      xlWkSht.Cells(k, 1) = .Cells(1, 1)
      xlWkSht.Cells(k, 2) = .Cells(1, 2)
      xlWkSht.Cells(k, 3) = .Cells(1, 3)
    End With
  End If
  With .Worksheets("Sheet1").UsedRange
    LRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
    For i = 1 To LRow
      ArrData = ArrData & .Cells(i, 1).Text & "|"
    Next
  End With
  With .Worksheets("Sheet2").UsedRange
    LRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
    For i = 0 To UBound(Split(ArrData, "|"))
      StrMatch = Split(ArrData, "|")(i)
      For j = 1 To LRow
        If .Cells(j, 2).Text = StrMatch Then
          k = k + 1
          xlWkSht.Cells(k, 1) = .Cells(j, 1)
          xlWkSht.Cells(k, 2) = .Cells(j, 2)
          xlWkSht.Cells(k, 3) = .Cells(j, 3)
        End If
      Next
    Next
  End With
End With
Set xlWkSht = Nothing
Application.ScreenUpdating = True
End Sub