Sub CopieParFiltreElab()
Dim fd As Worksheet: Set fd = Sheets("Feuil3")
With Sheets("Feuil1").Range("A1")
.Value = "ITEM1"
.AutoFill Destination:=.Resize(, 5), Type:=xlFillDefault
fd.Range("G1:G2") = Application.Transpose(Array("ITEM5", "jaune"))
.Range("A1:E6").AdvancedFilter Action:=2, CriteriaRange:=fd.Range("G1:G2"), CopyToRange:=fd.Range("A1"), Unique:=False
.Resize(, 5) = Empty
End With
fd.Rows(1) = Empty
fd.Range("G1:G2") = Empty
End Sub