Sub SupprimerDoublons()
Dim DerLigne As Long
Dim nom As String
Dim r As Range
Dim i As Long
DerLigne = Range("A" & Rows.Count).End(xlUp).Row
With Range("A1:A" & DerLigne).CurrentRegion
.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
nom = .Cells(.Rows.Count, 1)
For i = .Rows.Count - 1 To 1 Step -1
If .Cells(i, 1) = nom Then .Cells(i).EntireRow.Delete
nom = .Cells(i, 1)
Next
End With
End Sub