Sub SuppressionDesDoublons()
With Feuil1.Rows(2).Resize(Feuil1.Cells(Feuil1.Rows.Count, 1).End(xlUp).Row - 1)
.Sort Key1:=.Columns(5), Order1:=xlAscending, Key2:=.Columns(8), Order2:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
.Sort Key1:=.Columns(1), Order1:=xlAscending, Key2:=.Columns(4), Order2:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
.Sort Key1:=.Columns(6), Order1:=xlAscending, Key2:=.Columns(9), Order2:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
.Columns(16).FormulaR1C1 = "=AND(RC1=R[-1]C1,RC4=R[-1]C4,RC5=R[-1]C5,RC6=R[-1]C6,RC8=R[-1]C8,RC9=R[-1]C9)"
If Not WorksheetFunction.Or(.Columns(16)) Then MsgBox "Aucun doublon détecté.", _
vbInformation, "SuppressionDesDoublons": GoTo Fin
.Columns(15).FormulaR1C1 = "=RC10+IF(R[1]C16,R[1]C,0)"
.Columns(14).FormulaR1C1 = "=IF(RC16,""Suppr"",RC15)"
Columns(10).Value = .Columns(14).Value
.Columns(10).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
End With
Fin: Feuil1.[K:P].Delete
End Sub