Sub ab()
Dim ws As Worksheet
Dim r As Range, c As Range, cl&, i&, j&
Dim t() As Variant
i = 0
Set ws = Feuil1
ws.Cells.Clear
'/////ajout pour création test
ws.[A1] = "NOMS ONGLETS"
ws.[A2:A10] = Application.Transpose(Array(1, 2, 2, 3, 3, 3, 4, 5, 5))
Application.ScreenUpdating = True
MsgBox "Lancer la création des onglets sans doublons?", 64, "TEST"
'/////fin ajout
Application.ScreenUpdating = False
Set r = ws.Range(ws.[A1], ws.[A65536].End(xlUp))
r.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
cl = r.SpecialCells(xlCellTypeVisible).Count - 1
ReDim t(cl)
For Each c In r.SpecialCells(xlCellTypeVisible)
t(i) = c.Value
i = i + 1
Next c
For j = 1 To UBound(t)
Sheets.Add(After:=Sheets(Sheets.Count)).Name = t(j)
Next j
ws.ShowAllData
ws.Activate
End Sub