Dim m As New Dictionary, n As New Dictionary, t(), t1(), w As Long, i As Long, x As Long, z, k
Sub es()
t = Feuil3.Range("a1:A" & Feuil3.Cells(Rows.Count, 1).End(3).Row)
For i = 1 To UBound(t): n(t(i, 1)) = "": Next i
k = n.keys
t = Feuil1.Range("a2:f" & Feuil1.Cells(Rows.Count, 1).End(3).Row)
ReDim t1(1 To UBound(t), 1 To 6)
For i = 1 To UBound(t)
z = t(i, 3) & t(i, 4)
If Not m.Exists(z) Then
m.Add z, z
For w = 0 To n.Count - 1
x = x + 1
t1(x, 1) = t(i, 3): t1(x, 2) = t(i, 4): t1(x, 3) = k(w)
Next w
End If
Next i
Feuil2.[i2].Resize(x, 3) = t1
Set n = Nothing: Set m = Nothing: Erase t, t1: x = 0
End Sub