Sub SuppressionDoublons()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Plge As Range
Dim i As Integer, j As Integer
Set Plge = ActiveCell.CurrentRegion
i = 1
j = ActiveCell.Column - Plge.Column + 1
Plge.Sort key1:=ActiveCell, order1:=xlAscending
Do While Len(Plge.Cells(i, j).Value) > 0
If Plge.Cells(i, j).Value = Plge.Cells(i + 1, j).Value Then
Plge.Rows(i + 1).Delete Shift:=xlUp
Else
i = i + 1
End If
Loop
Application.Calculation = xlCalculationAutomatic
End Sub