Fragmenter une liste Excel dans de nouvelles feuilles

Bonjour à tous!

Je cherche depuis 2 jours comment arriver à ce que je veux, mais je crois que je n'arrive pas à bien verbaliser ce que je veux et mes recherches sont infructueuses pour le moment.

J'essaie de diviser et trier une grande liste excel dans plusieurs nouvelles feuilles pour ensuite pouvoir enregistrer chaque feuilles dans un nouveau fichier.

Ma liste contient des dates, un numéro de commande et des prix. Il m'arrive d'avoir plusieurs lignes par numéro de commande pour un nombre variable de ligne. Il faudrait donc qu'un tri se fasse pour rassembler chaque ligne d'une même commande dans une nouvelle feuille et que cette feuille soit nommé du numéro de la commande qu'elle contient.

Par la suite, je crois être en mesure de trouver comment enregistrer les nouvelles feuilles dans des fichiers différents, mais si vous pouvez m'indiquer comment, ça serait très apprécié.

Exemple de ma liste excel;

Je vous remerci d'avance!

Bonjour jeansib,

dans le fichier ci-joint, tu devrais trouver ton compte en modifiant un peu la macro "un fichier par onglet".

1- Peaufine l'onglet modèle, c'est à partir de ce dernier que te données seront scindées.

2- Ensuite active le bouton : scinder

3- Modifie les noms et le chemin de tes fichiers à créer.

Bonne journée.

rebonjour,

en relisant ton message, je me rends compte que tu va devoir trier tes données avant pour avoir tes numéros de commandes qui se suivent.

Sub trier()
Dim DerLig As Long



With ActiveSheet
DerLig = DerLig = Range("A" & Rows.Count).End(xlUp).Row
Range("A3:C" & DerLig).Select


ActiveWorkbook.Worksheets("Liste").Sort.SortFields.Add Key:=Range("B4:B" & DerLig), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Liste").Sort
.SetRange Range("A3:C" & DerLig)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With

End Sub

Quand ça fonctionnera, nous pourrons relier les trois macros ensemble.

Bonne journée.

Voici donc le fichier avec les trois macros

Bonjour Spage

J'ai tenté de modifier pour avoir tout mes données (Ma liste réelle commence de A à K avec l'entente sur la 1ere ligne et le numéro de la commande dans la colonne C)

Tout semble fonctionner, mon modèle fonctione, les nouvelles feuilles sont créées, mais elles sont vides. J'ai l'impression que le problème se situe à la fin de la macro

voici la macro que j'ai modifiée

Sub scinder()
Dim Cel As Range, Plg As Range
Dim DerLig As Long
Dim Numeros As Object
Dim Sh As Worksheet, FBase As Worksheet, FModele As Worksheet
Dim It As Variant
Set FBase = Sheets("Facturation")
Set FModele = Sheets("modele")
Set Numeros = CreateObject("Scripting.Dictionary")
T = Timer
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
For Each Sh In Sheets
If Sh.Name <> FBase.Name And Sh.Name <> FModele.Name Then
Sh.Delete
End If
Next Sh
With FBase
DerLig = .Cells(Rows.Count, 1).End(xlUp).Row
Set Plg = .Range("A1:k" & DerLig)
For Each Cel In .Range("C2:C" & DerLig)
If Cel.Value <> "" Then
Cel.Value = Format(Trim(Cel.Value), "000000000000000")
Numeros(Cel.Value) = Cel.Value
End If
Next Cel
End With
For Each It In Numeros.Items
FModele.Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = It
FBase.Range("CA4").FormulaR1C1 = "=RC2=" & It
Plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=FBase.Range("CA3:CA4"), _
CopyToRange:=.Range("A3:C3"), Unique:=False
DerLig = .Cells(Rows.Count, 1).End(xlUp).Row + 2

End With
Next It
FBase.Range("CA4").ClearContents
FBase.Select
MsgBox Timer - T
End Sub

Bonjour,

1- Essai de placer des données comme dans l'exemple, c'est-à-dire à partir de la ligne 3 dans la liste et de la ligne trois dans le modèle.

2- Plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=FBase.Range("CA3:CA4"), _
CopyToRange:=.Range("A3:C3"), Unique:=False

devrait être

Plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=FBase.Range("CA3:CA4"), _
CopyToRange:=.Range("A3:K3"), Unique:=False

3- FBase.Range("CA4").FormulaR1C1 = "=RC2=" & It

devrait être

FBase.Range("CA4").FormulaR1C1 = "=RC3=" & It ………….. pour la 3e colonne

ça devrait fonctionner.