Sub FiltreCopie()
Dim tablo, cel As Range, i As Byte, cop As Range
tablo = Array("FR", "DE", "UK") 'à compléter bien sûr
With Workbooks("mes codes.xls").Sheets("Feuil1") 'à adapter éventuellement
.Cells.Clear 'efface tout
Rows(1).Copy .[A1] 'copie la ligne de titre
For Each cel In Range("F2", Range("F65536").End(xlUp))
For i = 0 To UBound(tablo)
If cel.Text Like tablo(i) & "*" Then 'respecte la casse, sinon => Ucase(cel) Like tablo(i)
Set cop = Union(cel.EntireRow, IIf(cop Is Nothing, cel.EntireRow, cop))
GoTo 1
End If
Next
1 Next
cop.Copy .[A2]
End With
End Sub