filtre avec parametre

Sub macro()
Dim F1 As Range, F2 As Range
Dim cellule As Range, Trouve As Range
Dim i As Long, Fin As Long, Cherche As String

i = 1

Fin = Feuil1.[A65536].End(xlUp).Row

Set F1 = Feuil1.Range("A2:A" & Fin)
Set F2 = Feuil2.Range("A2:A" & Fin)

For Each cellule In F1
Cherche = cellule.Value
    If Not IsEmpty(Cherche) Then
    Set Trouve = F2.Columns(1).Cells.Find(Cherche, Lookat:=xlWhole)
        If Not Trouve Is Nothing Then
        Feuil3.Cells(i, "A").Offset(1, 0).Value = cellule.Value
        i = i + 1
        End If
    End If
Next
End Sub