Divisé 1 fichier en plusieur fichier en gardant la même entêtes

Bonjour,

J'ai 1 fichier que je souhaiterai divisé en plusieurs fichiers.

Je souhaiterai que ce fichier fasse 20 lignes maxi avec l'entête inclus.

Je vous ai mit un exemple en piece jointe

Merci d'avance pour votre aide.

Bonjour,

tu peux t'appuyer sur ceci avec un modèle de fichier comportant les en-têtes

https://www.excel-pratique.com/fr/telechargements/utilitaires/dispatcher-compiler-excel-no466

Bonjour,

Oui, c'est exactement ce que je veux faire mais je n'arrive pas a modifier la macro pour qu'il me fasse des 19 lignes

ok, il n'y a pas critères, il suffit juste de découper en paragraphes de 19 lignes plus en-tête ... cla simplifie mais il faut en effet réécrire

Pour modifier la macro , je suis pas trop fort et j'ai essaye le fichier que tu m'as fournie mais je n'arrive pas a modifier l'entete.

j'ai raccourci ton fichier test pour aller plus vite ...

Option Explicit
Sub fragmenter()
Dim i%, n%, Origine As Workbook, xl As Excel.Application, Cible As Workbook, ws As Worksheet, entetes

    Set Origine = ThisWorkbook

    Set xl = CreateObject("Excel.Application")
    xl.Visible = True

    n = 1
    entetes = Origine.Sheets(1).Range("A1:E1")
    For i = 2 To Origine.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Step 19
        Origine.Sheets(1).Range("A" & i & ":E" & i + 18).Copy
        Set Cible = xl.Workbooks.Add
        Set ws = Cible.Sheets(1)
            ws.Cells(2, 1).Select
            ws.Paste
            ws.Cells(1, 1).Resize(1, 5) = entetes
        Cible.SaveAs (Origine.Path & "\fichier#" & n & ".xlsx")
        Cible.Close
        n = n + 1
    Next
    xl.Quit
    Application.CutCopyMode = False

End Sub

Super merci.

Par contre j'ai besoin que le fichier sort en .csv

J'ai changé xlsx par csv mais lors de mon envoi , il me dit que ce n'est pas reconnu comme CSV

Option Explicit
Sub fragmenter()
Dim i%, n%, Origine As Workbook, xl As Excel.Application, Cible As Workbook, ws As Worksheet, entetes

    Set Origine = ThisWorkbook

    Set xl = CreateObject("Excel.Application")
    xl.Visible = True

    n = 1
    entetes = Origine.Sheets(1).Range("A1:E1")
    For i = 2 To Origine.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Step 19
        Origine.Sheets(1).Range("A" & i & ":E" & i + 18).Copy
        Set Cible = xl.Workbooks.Add
        Set ws = Cible.Sheets(1)
            ws.Cells(2, 1).Select
            ws.Paste
            ws.Cells(1, 1).Resize(1, 5) = entetes
            Cible.SaveAs Filename:=Origine.Path & "\fichier#" & n & ".csv", FileFormat:=xlCSV, CreateBackup:=False
            Cible.Close
        n = n + 1
    Next
    xl.Quit
    Application.CutCopyMode = False

End Sub

Bonjour,

La macro a bugger a la création du 10 eme classeur sur : ws.Paste

pas chez moi, tu dois avoir soit un problème de capacité, soit avoir un logiciel qui a actionné un copier en parallèle

ferme tout sauf excel et recommence

voici mon résultat

Oui c'etait exactement ca.

merci