Comparaison

Sub JoteMonPyjamaPourVictor21()
Feuil2.Range("E1:E2").Value = Feuil1.Range("A1:A2").Value
Feuil2.Range("A1:C3").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Feuil2.Range( _
        "E1:E2"), CopyToRange:=Feuil3.Range("A1"), Unique:=False
End Sub

Sub ChercherEtCopierTout()

 Dim f As Worksheet, f2 As Worksheet, f3 As Worksheet
 Dim After As Range, rg As Range
 Dim premiere As String
 
 Dim i As Long, ligne3 As Long
 
    Set f = ThisWorkbook.Worksheets("Feuil1")
    Set f2 = ThisWorkbook.Worksheets("Feuil2")
    Set f3 = ThisWorkbook.Worksheets("Feuil3")
    Dim What As Variant
    
    ligne3 = 1
    f3.Cells.Clear
    
    Set After = f2.Cells(f2.Rows.Count, 1)
    
    For i = 2 To f.Range("A" & f.Rows.Count).End(xlUp).Row
        
        What = f.Cells(i, 1)
        Set rg = f2.Columns(1).Find(What:=What, After:=After, LookIn:=xlFormulas, LookAt:=xlWhole, SearchFormat:=False, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        
        If Not rg Is Nothing Then
            premiere = ""
            While premiere <> rg.Address
                premiere = rg.Address
                
                ligne3 = ligne3 + 1
                f2.Rows(rg.Row).Copy f3.Cells(ligne3, 1)
                
                Set rg = f2.Columns(1).Find(What:=What, After:=rg, LookIn:=xlFormulas, LookAt:=xlWhole, SearchFormat:=False, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                
            Wend
        End If
        
    Next
    
End Sub

Sub Filtrer()
'Feuil1 Feuil2 Feuil3 sont les CodeNames des feuilles
Dim ad$
ad = Feuil1.[A1].CurrentRegion.Address(, , , True)
With Feuil2 'CodeName
  .[F2] = "=COUNTIF(" & ad & ",A2)"
  .[A1].CurrentRegion.AdvancedFilter xlFilterInPlace, .[F1:F2]
  Feuil3.Cells.Clear 'RAZ
  .[A1].CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Feuil3.[A1]
  .[A1].CurrentRegion.AdvancedFilter xlFilterInPlace, ""
  .[F2] = ""
End With
Feuil3.Activate
End Sub