Voici
Option Explicit
Sub decomposer()
fragmenter 11, "_", 28
fragmenter 12, "__", 20
End Sub
Sub fragmenter(n As Integer, prefixe As String, couleur As Integer)
Dim i%, cle As Variant, sw As Worksheet, dico As Object, tbl As Variant
Set sw = ActiveSheet
Set dico = CreateObject("Scripting.Dictionary")
With ActiveSheet.ListObjects(1)
If .ShowAutoFilter Then .AutoFilter.ShowAllData
tbl = .ListColumns(n).DataBodyRange
For i = 2 To UBound(tbl)
dico(tbl(i, 1)) = dico(tbl(i, 1)) + 1
Next
For Each cle In dico.Keys
If cle <> "" Then
.Range.AutoFilter Field:=n, Criteria1:=cle
.Range.Select
Selection.Copy
Sheets.Add After:=ActiveSheet
With ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.ListObjects.Add(xlSrcRange, Cells(1).CurrentRegion, , xlYes).Name = cle
.ListObjects(1).TableStyle = "TableStyleMedium2"
.Name = prefixe & cle
.Tab.ColorIndex = couleur
End With
sw.Select
End If
Next
.AutoFilter.ShowAllData
End With
Application.CutCopyMode = False
End Sub