Comment scinder un fichier en plusieurs à chaque changement de données

Sub test()

Dim newWbk As Workbook
Dim dossierSauvegarde As String, colonneDepartement As String
Dim i As Long, ligneDebutCopie As Long, ligneFinCopie As Long

'dossier où seraont créés les fichiers (à la racine du classeur dans l'exemple)
dossierSauvegarde = ThisWorkbook.Path

colonneDepartement = "J"

With ThisWorkbook.Sheets("Feuil1")
    'trier les données de la feuille par département
    .Range(.Range("A2"), .Range("A2").End(xlToRight).End(xlDown)).Sort key1:=.Range(colonneDepartement & "2"), order1:=xlAscending
    
    'boucler sur chaque entrée
    For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        'récupérer la ligne de la première valeur du "département traité"
        ligneDebutCopie = i
        'tant que la ligne suivant concerne le département traité
        While .Range(colonneDepartement & i).Text = .Range(colonneDepartement & i + 1).Text
            'incrémenter i (passer à la ligne suivante)
            i = i + 1
        Wend
        'récupérer la ligne de la dernière valeur du "département traité"
        ligneFinCopie = i
        
        'créer un nouveau classeur avec une seule feuille
        Set newWbk = Application.Workbooks.Add(xlWBATWorksheet)
        
        'copier la ligne de titre
        .Rows(1).Copy newWbk.Sheets(1).Range("A1")
        
        'copier les valeurs du "département traité"
        .Rows(ligneDebutCopie & ":" & ligneFinCopie).Copy newWbk.Sheets(1).Range("A2")
        
        'sauver le nouveau classeur
        newWbk.SaveAs dossierSauvegarde & "\" & .Range(colonneDepartement & i).Text
        
        'fermer le nouveau classeur
        newWbk.Close True
    Next i
End With
End Sub