Sub Eclater_Dico_cp4()
Dim F As Worksheet, ws As Worksheet, tablo, d As Object, i&, a
Set F = Worksheets("Base") '
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
For Each ws In Worksheets
If ws.Name <> F.Name Then ws.Delete
Next ws
tablo = F.[AB5].CurrentRegion.Columns(28).Resize(, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
If tablo(i, 1) <> "" Then d(tablo(i, 1)) = ""
Next i
If d.Count = 0 Then Exit Sub
a = d.keys
With F.[A5].CurrentRegion
For i = 0 To UBound(a)
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = a(i)
.AutoFilter 28, a(i)
.Copy ActiveSheet.Cells(1)
Next i
End With
F.AutoFilterMode = False
F.Activate
End Sub