Macro pour découper un fichier excel

marycool · 11 Septembre 2008

Bonjour,

Vous trouverez ci-joint un fichier Excel qui comporte 7 colonnes, dont une qui contient le nom des magasins. Je voudrais créer un fichier par magasin en conservant l'en-tete sur chaque fichier. J'ai un listing complet avec tous les tarifs de cette année et j'ai créee une colonne pour que le magasin puisse indiquer son nouveau tarif mais il faut que je découpe ce listing en créant un nouveau classeur pour chaque fournisseur afin de pouvoir l'envoyer par mail.

Le fichier original contient plus de 3000 lignes (qui correspondent à 3000 produits) et 200 magasins différents.

Une macro peut elle découper ce fichier et créer pour chaque fournisseur un nouveau classeur?

Merci d'avance pour votre retour!!

Mary

PS: je n'arrive pas à joindre le fichier à ce mail...

marycool · 11 Septembre 2008

Re : Macro pour découper un fichier excel

La pièce jointe...

marycool · 11 Septembre 2008

Re : Macro pour découper un fichier excel

Mon message n'est peu-être pas clair ou est ce tout simplement impossible à réaliser??
De nombreux post ont eu des réponses depuis l'heure ou j'ai deposé le mien, est ce normal?
Merci pour vos commentaires!!
Marycool

myDearFriend! · 11 Septembre 2008

Re : Macro pour découper un fichier excel

Bonsoir marycool,

En pièce jointe peut-être une façon de faire.

J'ai utilisé la procédure VBA suivante :

Code:

[COLOR=GRAY][B][I]DANS UN MODULE DE CODE STANDARD[/I][/B][/COLOR]

[COLOR=NAVY]Option Explicit[/COLOR]

[COLOR=NAVY]Sub[/COLOR] Traitement()
[COLOR=GREEN]'myDearFriend! - www.mdf-xlpages.com[/COLOR]
[COLOR=NAVY]Dim[/COLOR] CollMag [COLOR=NAVY]As New[/COLOR] Collection
[COLOR=NAVY]Dim[/COLOR] Plage [COLOR=NAVY]As[/COLOR] Range
[COLOR=NAVY]Dim[/COLOR] L [COLOR=NAVY]As Long[/COLOR], L2 [COLOR=NAVY]As Long[/COLOR], Lmax [COLOR=NAVY]As Long[/COLOR]
    Application.ScreenUpdating = [COLOR=NAVY]False
    With[/COLOR] Sheets("Feuil1")       [COLOR=GREEN]'A adapter ![/COLOR]
        Lmax = .Cells(Application.Rows.Count, 1).[COLOR=NAVY]End[/COLOR](xlUp).Row
        [COLOR=GREEN]'Création de la liste des magasins (sans doublons)[/COLOR]
        [COLOR=NAVY]On Error Resume Next
        For[/COLOR] L = 2 [COLOR=NAVY]To[/COLOR] Lmax
            CollMag.Add .Cells(L, 2).Text, .Cells(L, 2).Text
        [COLOR=NAVY]Next[/COLOR] L
        [COLOR=NAVY]On Error GoTo[/COLOR] 0
        [COLOR=GREEN]'Création des classeurs[/COLOR]
        [COLOR=NAVY]For[/COLOR] L = 1 [COLOR=NAVY]To[/COLOR] CollMag.Count
            [COLOR=GREEN]'Copie de l'onglet[/COLOR]
            .Copy
            [COLOR=GREEN]'Epurage des données par magasin[/COLOR]
            [COLOR=NAVY]With[/COLOR] ActiveSheet
                [COLOR=NAVY]Set[/COLOR] Plage = .Rows(Application.Rows.Count)
                [COLOR=NAVY]For[/COLOR] L2 = 2 [COLOR=NAVY]To[/COLOR] Lmax
                    [COLOR=NAVY]If[/COLOR] .Cells(L2, 2).Text <> CollMag(L) [COLOR=NAVY]Then
                        Set[/COLOR] Plage = Union(Plage, .Rows(L2))
                    [COLOR=NAVY]End If
                Next[/COLOR] L2
                Plage.Delete
            [COLOR=NAVY]End With[/COLOR]
            [COLOR=GREEN]'Sauvegarde classeur "magasin X"[/COLOR]
            [COLOR=NAVY]With[/COLOR] ActiveWorkbook
                .SaveAs ThisWorkbook.Path & "\Mag " & CollMag(L) & ".xls"
                .[COLOR=NAVY]Close
            End With
        Next[/COLOR] L
    [COLOR=NAVY]End With[/COLOR]
    Application.ScreenUpdating = [COLOR=NAVY]True[/COLOR]
    MsgBox CollMag.Count & " classeurs créés"
[COLOR=NAVY]End Sub[/COLOR]

Pour lancer la macro : faire ALT+F8 et exécuter la macro "Traitement".
Les classeurs sont créés sur le disque dur sous le même chemin que le classeur "Maître" (celui qui contient les données et la macro).

Bonne continuation pour la suite.

Cordialement,

marycool · 12 Septembre 2008

Re : Macro pour découper un fichier excel

Bonjour et merci beaucoup pour votre aide.
Le code sur le fichier test fonctionne très bien!!
Par contre, lorsque j'essaie de l'appliquer à mon fichier, celui ci bloque à copy.

Option Explicit

Sub Traitement()
'myDearFriend! - mon Univers Excel... : myDearFriend! Excel Pages
Dim CollMag As New Collection
Dim Plage As Range
Dim L As Long, L2 As Long, Lmax As Long
Application.ScreenUpdating = False
With Sheets("Feuil1") 'A adapter !
Lmax = .Cells(Application.Rows.Count, 1).End(xlUp).Row
'Création de la liste des fournisseurs (sans doublons)
On Error Resume Next
For L = 2 To Lmax
CollMag.Add .Cells(L, 2).Text, .Cells(L, 2).Text
Next L
On Error GoTo 0
'Création des classeurs
For L = 1 To CollMag.Count
'Copie de l'onglet
.Copy
'Epurage des données par fournisseur
With ActiveSheet
Set Plage = .Rows(Application.Rows.Count)
For L2 = 2 To Lmax
If .Cells(L2, 2).Text <> CollMag(L) Then
Set Plage = Union(Plage, .Rows(L2))
End If
Next L2
Plage.Delete
End With
'Sauvegarde classeur "fournisseur X"
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\Mag " & CollMag(L) & ".xls"
.Close
End With
Next L
End With
Application.ScreenUpdating = True
MsgBox CollMag.Count & " classeurs créés"
End Sub

Savez vous quel peut-etre le problème?

Merci d'avance,

Marycool

marycool · 12 Septembre 2008

Re : Macro pour découper un fichier excel

MERCI my dear friend!!!

Après quelques manip, ça marche!!!

Mon seul soucis est que la ligne 2 apparait dans chaque classeur, j'ai modifié comme suit, car en fait mon magasin est en colonne 3 contrairement au test où le magasin était en colonne 2 . J'ai donc mis des 3 à la place de tes 2 puisque la colonne à prendre en compte est la colonne 3 mais il y a surement un nombre que je ne dois pas changer...

Option Explicit

Sub Traitement()
'myDearFriend! - mon Univers Excel... : myDearFriend! Excel Pages
Dim CollMag As New Collection
Dim Plage As Range
Dim L As Long, L3 As Long, Lmax As Long
Application.ScreenUpdating = False
With Sheets("Feuil1") 'A adapter !
Lmax = .Cells(Application.Rows.Count, 1).End(xlUp).Row
'Création de la liste des magasins (sans doublons)
On Error Resume Next
For L = 3 To Lmax
CollMag.Add .Cells(L, 3).Text, .Cells(L, 3).Text
Next L
On Error GoTo 0
'Création des classeurs
For L = 2 To CollMag.Count
'Copie de l'onglet
.Copy
'Epurage des données par magasin
With ActiveSheet
Set Plage = .Rows(Application.Rows.Count)
For L3 = 3 To Lmax
If .Cells(L3, 3).Text <> CollMag(L) Then
Set Plage = Union(Plage, .Rows(L3))
End If
Next L3
Plage.Delete
End With
'Sauvegarde classeur "magasin X"
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\Mag " & CollMag(L) & ".xls"
.Close
End With
Next L
End With

Mais je devrais ptet arriver à trouver!

Dans tous les cas, ça va me faire gagner un temps fou!

Marycool

JCGL · 12 Septembre 2008

Re : Macro pour découper un fichier excel

Bonjour à tous,

Pourrais-tu essayer avec :

Code:

Option Explicit
 
Sub Traitement()
'myDearFriend! - [URL="http://www.mdf-xlpages.com/"]mon Univers Excel... : myDearFriend! Excel Pages[/URL]
Dim CollMag As New Collection
Dim Plage As Range
Dim L As Long, L2 As Long, Lmax As Long
Application.ScreenUpdating = False
With Sheets("Feuil1") 'A adapter !
Lmax = .Cells(Application.Rows.Count, 1).End(xlUp).Row
'Création de la liste des magasins (sans doublons)
On Error Resume Next
For L = 2 To Lmax
CollMag.Add .Cells(L, 3).Text, .Cells(L, 3).Text
Next L
On Error GoTo 0
'Création des classeurs
For L = 2 To CollMag.Count
'Copie de l'onglet
.Copy
'Epurage des données par magasin
With ActiveSheet
Set Plage = .Rows(Application.Rows.Count)
For L2 = 2 To Lmax
If .Cells(L2, 3).Text <> CollMag(L) Then
Set Plage = Union(Plage, .Rows(L2))
End If
Next L2
Plage.Delete
End With
'Sauvegarde classeur "magasin X"
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\Mag " & CollMag(L) & ".xls"
.Close
End With
Next L
End With

Et que mDF me pardonne de mon intrusion 😉

A+

marycool · 12 Septembre 2008

Re : Macro pour découper un fichier excel

Merci merci JCGL, en effet, ça marche !!!

Bonne journée et merci encore!!

Marycool

marycool · 28 Octobre 2008

Re : Macro pour découper un fichier excel

Bonjour,

Une dernière petite question pour que ce soit parfait à savoir est-il possible de rajouter une protection de feuille par mot de passe de chaque classeur ouvert (afin que l'on puisse compléter la colonne tarif achat 2008 mais sans pouvoir modifier les autres colonnes). Car en fait on ne peut pas découper une feuille protégé donc il faudrait que ça soit ajouté par la suite à chaque feuille.

Merci d'avance,

Marycool

JCGL · 28 Octobre 2008

Re : Macro pour découper un fichier excel

Bonjour à tous,

Peux-tu redéposer le fichier avec les magasins dans la bonne colonne ?

Ensuite un :

Code:

.UnProtect

et un :

Code:

.Protect

judicieusement placés devraient te satisfaire

A+ à tous

nickos2406 · 18 Février 2015

Re : Macro pour découper un fichier excel

Bonjour,

Je rebondis sur cette discussion, car j'ai la même problématique.. J'ai appliqué la macro en l'adaptant à mon fichier joint, mais je n'arrive pas à la faire fonctionner... J'ai bien un fichier créé par zone, mais le fichier est vide 🙁...

Par ailleurs, outre la résolution de ce problème sur lequel je bute, je souhaite étendre la macro pour qu'elle puisse découper le fichier sur tous les onglets présents...(nombre d'onglets qui varie...)... et filtre sur la même zone, comme les onglets sont identiques...

Pourriez vous m'aider dans ma quête? et déjà savoir pourquoi il me retourne un fichier créé vide...?

Merci d'avance
Nickos

nickos2406 · 18 Février 2015

Re : Macro pour découper un fichier excel

bonsoir...

Personne n'aurait une idée pour m'aider à avancer ?

Merci pour le coup de pouce..

Nickos

Modeste · 19 Février 2015

Re : Macro pour découper un fichier excel

Bonjour nickos2406,

Le problème des anciennes discussions qu'on exhume c'est que parfois on ne voit pas que quelqu'un y ajoute une question récente 🙁

Pour les fichiers créés, en fait (et en imaginant que j'aie bien compris!?), il reste une correction à apporter en ligne 31: écris If .Cells(L2, 4).Text <> CollMag(L) Then au lieu de If .Cells(L2, 2).Text <> CollMag(L) Then

Pour le reste, il faut que tu expliques un peu plus clairement ce qui figure dans tes différents onglets: dans ta pièce jointe, le dernier onglet serait une "compilation" des 2 premiers ... ça n'aurait guère de sens de "splitter" ensuite les différents onglets dans autant de fichiers distinct, puisque tu auras des données en double 😕

nickos2406 · 19 Février 2015

Re : Macro pour découper un fichier excel

Bonjour,

Merci beaucoup déjà pour ce coup de pouce...

pour le reste, en fait ce que je cherche à faire c'est de filtrer la région sur la feuille 1, puis la coller dans un nouveau fichier... ensuite, c'est de filtrer sur la même région dans la feuille 2 et le coller dans un nouvel onglet de ce nouveau fichier créé, etc... pour l'ensemble des onglets présents dans le fichier d'origine...
Ce qui facilite la "tâche", on va dire, c'est que tous les onglets ont les mêmes colonnes, donc, le filtre s'applique sur la même colonne. Pas contre le nombre d'onglets varie d'un mois à l'autre, et je n'ai pas systématiquement 3 onglets. Je peux me retrouver avec 2 ou plus...
Bref, c'est là un gros travail, sur lequel j'ai commencé à bosser... Et si vous avez des pistes, je suis grandement preneur et reconnaissant.

Pour l'onglet compil, c'est en fait un onglet comme les autres, la logique reste la même, il faut filtrer copier-coller dans le nouveau fichier...

Merci d'avance, je continue ma recherche en parallèle, mais la tache s'annonce ardue 🙂
Nickos

nickos2406 · 19 Février 2015

Re : Macro pour découper un fichier excel

Une idée world? 😀
Merci pour votre aide, parce que j'arrive pas à trouver la logique pour copier plusieurs onglets filtrés dans un meme nouveau classeur...

Merci d'avance.
Nickos

Macro pour découper un fichier excel

marycool

XLDnaute Nouveau

marycool

XLDnaute Nouveau

Pièces jointes

marycool

XLDnaute Nouveau

myDearFriend!

XLDnaute Barbatruc

Pièces jointes

marycool

XLDnaute Nouveau

marycool

XLDnaute Nouveau

JCGL

XLDnaute Barbatruc

marycool

XLDnaute Nouveau

marycool

XLDnaute Nouveau

JCGL

XLDnaute Barbatruc

nickos2406

XLDnaute Junior

Pièces jointes

nickos2406

XLDnaute Junior

Modeste

XLDnaute Barbatruc

nickos2406

XLDnaute Junior

nickos2406

XLDnaute Junior

Discussions similaires

Macro pour découper un fichier excel

XLDnaute Nouveau

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Junior

Discussions similaires

Privacy & Transparency

Privacy & Transparency