Découper une feuille en plusieurs classeurs

Sub Macro1()
Dim os As Object 'déclare la variable os (Ongelt Source)
Dim n As String 'déclare la variable n (Nom)
Dim ch As String 'déclare la variable ch (CHemin)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim li As Long 'déclare la variable li (LIgne)
Dim i As Byte 'déclare la variable i (Incrément)
Dim cd As Workbook 'déclare la variable cd (Classeur Destination)
Dim od As Object 'déclare la variable od (Onglet Destination)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set os = ThisWorkbook.Sheets(1) 'définit l'onglet source os (ici le premier onglet du classeur, à adapter à ton cas)
n = Split(ThisWorkbook.Name, ".")(0) 'définit le nom n (nom du fichier sans l'extension)
ch = ThisWorkbook.Path & "\" 'définit le chemin d'accès
dl = os.UsedRange.Rows.Count 'définit la dernière ligne éditée dl du tableau source
i = 1 'initialise la variable i
For li = 2 To dl Step 10000 'boucle sur toutes les lignes du tableau par lot de 10000
    Application.Workbooks.Add 'ajoute un nouveau classeur
    Set cd = ActiveWorkbook 'définit le classeur destination cd
    cd.SaveAs (ch & n & "-P" & i & ".xlsx") 'enregistre-sous le nouveau classeur : nom-Pi.xlsx (à adapter en ".xls" si tu es sous excel 2003)
    Set od = cd.Sheets(1) 'définit l'onglet de destination (ici le premier, à adapter à ton cas)
    Set dest = od.Range("A1") 'définit la cellule de destination dest
    os.Rows(1).Copy dest 'copie la première ligne et la colle dans dest
    os.Range(os.Cells(li, 1), os.Cells(li + 9999, 1)).EntireRow.Copy dest.Offset(1, 0) 'copie 10000 lignes et les colle dans dest décalé d'une ligne vers le bas
    cd.Close SaveChanges:=True 'ferme, en enregistrant, le classeur de destination cd
    i = i + 1 'incrément i
Next li 'prochain lot de 10000 lignes de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub