Sub es()
Dim t, t1, t2, m As Object, x As Long, x1 As Long, x2 As Long ', m As Dictionary
Set m = CreateObject("Scripting.Dictionary")
' Set m = New Dictionary '
t = Feuil1.Range("a2:h" & Feuil1.Cells(Rows.Count, 4).End(3).Row)
t2 = Feuil1.Range("r2:s" & Feuil1.Cells(Rows.Count, 18).End(3).Row)
ReDim t1(1 To UBound(t), 1 To 8)
For x2 = 1 To UBound(t2)
If Not m.Exists(t2(x2, 1)) Then m.Item(t2(x2, 1)) = m.Item(t2(x2, 1))
Next
For x1 = 1 To UBound(t)
If Not m.Exists(t(x1, 4)) Then
x = x + 1
For c = 1 To 8: t1(x, c) = t(x1, c): Next c
End If
Next
Feuil2.Range("b12").Resize(x, 8) = t1
Erase t, t1, t2: Set m = Nothing
End Sub