Microsoft 365 Créer autant d'onglet que de commune dans ma base principale

Sub AjouterFeuilles()
Dim i&, d As Object, tablo, com$, F As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = Worksheets.Count To 1 Step -1
    If Worksheets.Count > 1 And Not LCase(Sheets(i).Name) Like "base*" Then Sheets(i).Delete
Next
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With Worksheets(1).[A1].CurrentRegion
    tablo = .Value 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        com = tablo(i, 3)
        If Not d.exists(com) Then
            d(com) = ""
            Set F = Sheets.Add(After:=Sheets(Sheets.Count))
            F.Name = com
            .AutoFilter 3, com 'filtre automatique
            .Copy F.Cells(1) 'copier-coller
            .AutoFilter 'ôte le filtre
        End If
    Next
    .Parent.Activate '1ère feuille
End With
End Sub

Sub SortWorkBook()
    'Updateby20140624
    Dim xResult As VbMsgBoxResult
    xTitleId = "KutoolsforExcel"
    xResult = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) & "Clicking No will sort in Descending Order", vbYesNoCancel + vbQuestion + vbDefaultButton1, xTitleId)
    For i = 1 To Application.Sheets.Count
        For j = 1 To Application.Sheets.Count - 1
            If xResult = vbYes Then
                If UCase$(Application.Sheets(j).Name) > UCase$(Application.Sheets(j + 1).Name) Then
                    Sheets(j).Move after:=Sheets(j + 1)
                End If
                ElseIf xResult = vbNo Then
                    If UCase$(Application.Sheets(j).Name) < UCase$(Application.Sheets(j + 1).Name) Then
                        Application.Sheets(j).Move after:=Application.Sheets(j + 1)
                End If
            End If
        Next
    Next
    End Sub

Private Sub ComboBox1_Change()
On Error Resume Next
Sheets(ComboBox1.Text).Activate
End Sub

Private Sub UserForm_Initialize()
Dim w As Worksheet
For Each w In Worksheets
    ComboBox1.AddItem w.Name
Next
End Sub

Private Sub ComboBox1_Change()
On Error Resume Next
Sheets(ComboBox1.Text).Activate
End Sub

Private Sub UserForm_Initialize()
Dim w As Worksheet
For Each w In Worksheets
    ComboBox1.AddItem w.Name
Next
End Sub