Sub Supprimer_doublons()
Dim d As Object, a, i&, x
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
With [A1].CurrentRegion.EntireRow 'lignes entières pour conserver les hauteurs des lignes
    a = .Columns(3).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To UBound(a)
        x = a(i, 1)
        If IsError(x) Then
            a(i, 1) = 1
        Else
            If d.exists(x) Then a(i, 1) = "#N/A" Else a(i, 1) = 1: d(x) = ""
        End If
    Next
    '---restitution et filtrage---
    .Columns(3).EntireColumn.Insert 'insère une colonne auxiliaire
    .Columns(3) = a
    .Sort .Columns(3), xlAscending 'tri pour regrouper et accélérer
    On Error Resume Next 'si aucune SpecialCell
    .Columns(3).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les doublons
    .Columns(3).EntireColumn.Delete 'supprime la colonne auxiliaire
End With
End Sub
Sub Reinitialiser()
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
Sheets("Initialisation").Cells.Copy [A1]
[A1].Copy [A1] 'allège la mémoire
End Sub