Dim m As Object, i As Long, z As Variant
On Error Resume Next
Application.ScreenUpdating = False
Set m = CreateObject("Scripting.Dictionary")
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
z = Cells(i, 1) & Cells(i, 2) & Cells(i, 3) & Cells(i, 4) & Cells(i, 5) & Cells(i, 6)
If Not m.Exists(z) Then
m.Add z, z
Else
Cells(i, 1).Resize(1, 6).Cut Destination:=Sheets("Doublons").Cells(Rows.Count, 1).End(xlUp)(2)
End If
Next i
Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete