Private Sub CommandButton1_Click()
Dim TNR$, i%, ii%
TNR = ActiveCell
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
If Sheets(i).Name <> "List4" Then
    With Sheets(i)
       For ii = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
         If .Cells(ii, 1) = TNR Then
         .Rows(ii).Copy
         Sheets("List4").Cells(Sheets("List4").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial
         End If
       Next ii
    End With
End If
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub