Sub OrdreRespectéDictionary()
Set MonDico = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
n = [A65000].End(xlUp).Row
i = 17
Do While i <= n
If Cells(i, "B") <> "" Then
If Not MonDico.Exists(Cells(i, "B") & Cells(i, "C") & Cells(i, "D")) Then
MonDico.Add Cells(i, "B") & Cells(i, "C") & Cells(i, "D"), Cells(i, "b") & Cells(i, "C") & Cells(i, "D")
i = i + 1
Else
Rows(i).EntireRow.Delete
End If
Else
i = i + 1
End If
Loop
End Sub