XL 2019 Excel différentes feuilles

Option Explicit
Dim cle, MaFeuil As Worksheet
Sub dispatcher()
    Dim ws As Worksheet, cel As Range, Rng As Range, d As Object
    Set MaFeuil = Sheets("Nov 2021")
    Set d = CreateObject("scripting.dictionary") 'dictionnaire

    With MaFeuil
        If .FilterMode = True Then .ShowAllData

        Set Rng = .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row)
        For Each cel In Rng
            d(cel.Value) = "" 'données sans doublon
        Next cel

        If d.Count > 0 Then 's'il y a des données
            For Each cle In d.keys 'boucle
                If Contains(Sheets, CStr(cle)) Then 'si feuille existe
                    Sheets(CStr(cle)).Cells.Clear 'on efface tout
                    FiltrerCopierColler 'appel procédure
                Else
                    Sheets.Add(after:=Sheets(Sheets.Count)).Name = cle 'sinon on ajoute feuille+nom
                    FiltrerCopierColler 'appel procédure
                End If
            Next cle
        End If

    End With
    Set MaFeuil = Nothing: Set d = Nothing
End Sub

Sub FiltrerCopierColler()
    Dim maplage As Range
    Application.ScreenUpdating = False
    With MaFeuil
        .Activate
        If .FilterMode = True Then .ShowAllData 'si filtre afficher tout
        .Range("B1").AutoFilter Field:=1, Criteria1:=cle 'filtrage
        Set maplage = .Range("B1:" & .Range("C65536").End(xlUp).Address).SpecialCells(xlCellTypeVisible) ' affecte lignes visibles à variable
        maplage.Copy Sheets(CStr(cle)).Range("A1") 'copie/colle
        Sheets(CStr(cle)).Range("A:B").Columns.AutoFit 'ajuste largeur colonne destination
        If .FilterMode = True Then .ShowAllData 'si filtre afficher tout
    End With
    Application.ScreenUpdating = True
    Set maplage = Nothing
End Sub

Public Function Contains(objCollection As Object, strName As String) As Boolean
'Cette fonction peut être utilisée avec toute collection comme objet ( Shapes, Range, Names, Workbooks, etc.).
'Pour vérifier l'existence d'une feuille, utilisez If Contains(Sheets, "SheetName") ...
    Dim o As Object
    On Error Resume Next
    Set o = objCollection(strName)
    Contains = (Err.Number = 0)
    Err.Clear
 End Function