Option Explicit

Public Sub Filter_Data()
Dim wb As Workbook
Dim ws As Worksheet, wsData As Worksheet, wsNew As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim lRow As Long
Dim Cell As Range

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set wb = ActiveWorkbook
    Set wsData = ActiveSheet
    wsData.Name = wsData.Cells(3).Text
    Set lo = wsData.ListObjects(1)

    For Each ws In wb.Worksheets
        If ws.Name <> wsData.Name Then ws.Delete
    Next ws

    Application.DisplayAlerts = True

    If lo.ShowAutoFilter Then lo.AutoFilter.ShowAllData

    Set ws = wb.Worksheets.Add

    With ws
        lo.ListColumns(12).Range.AdvancedFilter _
                Action:=xlFilterCopy, _
                copytorange:=.Cells(1), unique:=True
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For Each Cell In .Cells(2, 1).Resize(lRow - 1)
            lo.Range.AutoFilter field:=12, Criteria1:=Cell.Value
            Set wsNew = wb.Worksheets.Add(after:=Worksheets(Worksheets.Count))
            wsNew.Name = Cell.Value
            lo.Range.SpecialCells(xlCellTypeVisible).Copy
            With wsNew
                With .Cells(1)
                    .PasteSpecial xlPasteColumnWidths
                    .PasteSpecial xlPasteValuesAndNumberFormats
                End With
                Application.CutCopyMode = False
                Set lo2 = .ListObjects.Add(xlSrcRange, .Cells(1).CurrentRegion, , xlYes)
                With lo2
                    .Name = "T_" & Cell.Value
                    .TableStyle = "TableStyleLight11"
                End With
            End With
            lo.Range.AutoFilter field:=12
        Next Cell
    End With

    Application.DisplayAlerts = False
    ws.Delete

    With wsData
        .Activate
        .Cells(1).Select
    End With
    
    MsgBox "Les onglets ont été crées!...", vbInformation, "Création onglets"

End Sub