comment faire pour supprimer les doublons?

[B]Respecte l'ordre:[/B]

Sub supdoublons()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Set champ = Range("A2:A" & [A65000].End(xlUp).Row)
  For i = [A65000].End(xlUp).Row To 1 Step -1
    If Application.CountIf(champ, Cells(i, 1)) > 1 Then Rows(i).Delete
  Next i
  Application.Calculation = xlAutomatic
End Sub

ou

[B]Tri en ordre croissant:[/B]

Sub supDoublonsTradi()
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   [A2].Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
   For i = [A65000].End(xlUp).Row To 2 Step -1
     If Cells(i, 1) = Cells(i - 1, 1) Then Rows(i).Delete
   Next i
   Application.Calculation = xlCalculationAutomatic
End Sub

Sub OrdreRespectéDictionaryRapide()
  Set MonDico = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  i = 2
  Do While Cells(i, "A") <> ""
    If Not MonDico.Exists(Cells(i, "A") & Cells(i, "C")) Then
        MonDico.Add Cells(i, "A") & Cells(i, "C"), Cells(i, "A") & Cells(i, "C")
        i = i + 1
     Else
        Rows(i).EntireRow.Delete
     End If
  Loop
  Application.Calculation = xlCalculationAutomatic
End Sub