Création macro, pour créer plusieurs fichiers

Bonjour à tous,

J'aimerai faire une macro qui en fonction d'un tableau viens me créer dans un dossier plusieurs fichiers.

Je m'explique, pour donner un exemple avec le fichier ci-joint;

Je voudrais que en executant la macro, 5 fichiers se créer selon 3 conditions.

Le fichier 1:

est un tableau avec pour condition 1: filter colonne A sur "2" : condition 2: filtrer la colonne B sur "O"; condition 3: filtrer la colonne C sur "O"

Le fichier 2:

est un tableau avec pour condition 1: filter colonne A sur "3" : condition 2: filtrer la colonne B sur "O"; condition 3: filtrer la colonne C sur "O"

Le fichier 3:

est un tableau avec pour condition 1: filter colonne A sur "4" : condition 2: filtrer la colonne B sur "O"; condition 3: filtrer la colonne C sur "O"

En gros je voudrait que la macro trie le tableau selon mes 3 conditions puis créer un fichier dans un répertoire choisis et cela répéter pour tout les numéros de la colonne A; (1,2,3,4,5)

Deux questions, est ce réalisable ? si oui pourriez vous m'orienter vers une piste de réalisation ?

N'hésitez pas à me dire si mon post n'est aps compréhensible..

En vous souhaitant une bonne soirée et dans l'attente de vous lire.

34test.xlsx (8.08 Ko)

Bonjour

en essai... de ce que j'ai compris... appuie sur le bouton bleu pour lancement de la macro...

Par manque d'information de ta part... les fichiers créés sont dans un sous dossier par rapport ou se trouve le fichier qui va exécuter la macro... ce dossier s'appel "export" et il est créé par macro si le dossier n'existe pas...

Fred

73test.xlsm (21.24 Ko)

Bonjour Simon, bonjour le forum,

Je te propose le code ci-dessous. Il crée d'abord un onglet par critère puis enregistre l'onglet dans un fichier (dans le même dossier que le classeur Source, à adapter en modifiant la variable CA...). À la fin les onglets créés sont supprimés...

Le code :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim PL As Range 'déclare la variable PL (PLage)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim OD() As Variant 'déclare le tableau de variables OD (Onglets Destination)
Dim CC As Workbook 'déclare la variable CC (Classeur Copie)

Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
CA = CS.Path & "\" 'définit le chemin d'accès CA
Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS
Set PL = OS.Range("A1").CurrentRegion 'définit la plage PL
TV = PL 'd;efinit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
    D(TV(I, 1)) = "" 'aliment ele dictionnaire D avec les données en colonne 1 de TV
Next I 'prochane ligne de la boucle
TMP = D.keys 'récupère dans le tableau temmporaire TMP la liste des éléments du dictionnaire D sans doublon
ReDim OD(1 To D.Count) 'redimensionne le tableau des onglets destination
For I = 0 To UBound(TMP) 'boucle sur tous les éléments du tableau temporaire TMP
    If OS.FilterMode = True Then OS.ShowAllData 'si l'onglet OS est filtré, affiche toutes les données
    OS.Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=TMP(I) 'filtre la colonne A par rapport au ctritère TMP(I)
    OS.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:="O" 'filtre la colonne B par rapport au ctritère "O"
    OS.Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:="O" 'filtre la colonne C par rapport au ctritère "O"
    Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
    Set OD(I + 1) = ActiveSheet 'de'finit l'onglet destination OD(I)
    OD(I + 1).Name = "Critère " & TMP(I) 'renome l'onglet
    OS.Range(PL.Address).Copy OD(I + 1).Range("A1") 'copy la plage PL de l'onglet source et la colle dans A1 de l'onglet destination
Next I 'prochaie élément de la boucle
If OS.FilterMode = True Then OS.ShowAllData 'si l'onglet OS est filtré, affiche toutes les données
Application.DisplayAlerts = False 'n'affiche pas les messages Excel
For I = CS.Sheets.Count To 2 Step -1 'boucle inversée sur tous les onglets du classeur (du dernier au second)
    CS.Worksheets(I).Copy 'crée un nouveau classeur avec l'onglet de la boucle
    ActiveWorkbook.SaveAs CA & CS.Worksheets(I).Name, 51 'renregiste le classeur sous
    Set CC = ActiveWorkbook 'définit la classeur copie CC
    CC.Close False 'ferme le classeur CC
    CS.Worksheets(I).Delete 'suprime l'onglet de la boucle du classeur source
Next I 'prochaine onglet de la boucle
Application.DisplayAlerts = True 'affiche les messages d'excel
Application.ScreenUpdating = True 'affiche les rafraîchissement d'écran
MsgBox "Données traitées !" 'message de fin
CS.Save 'enregister le classeur source
End Sub

[Édition]

Bonjour Fred, nos posts se sont croisés...

Bonjour

en essai... de ce que j'ai compris... appuie sur le bouton bleu pour lancement de la macro...

Par manque d'information de ta part... les fichiers créés sont dans un sous dossier par rapport ou se trouve le fichier qui va exécuter la macro... ce dossier s'appel "export" et il est créé par macro si le dossier n'existe pas...

Fred

Bonjour Fred,

Je te remercie, c'est excatement ce que je cherchais à faire. Je vais essayer de comprendre comment ça fonctionne et l'étendre à un tableau un peu plus complet. (je peux revenir vers toi si j'ai un peu de mal?)

Bonne journée

Simon

Bonjour Simon, bonjour le forum,

Je te propose le code ci-dessous. Il crée d'abord un onglet par critère puis enregistre l'onglet dans un fichier (dans le même dossier que le classeur Source, à adapter en modifiant la variable CA...). À la fin les onglets créés sont supprimés...

Le code :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim PL As Range 'déclare la variable PL (PLage)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim OD() As Variant 'déclare le tableau de variables OD (Onglets Destination)
Dim CC As Workbook 'déclare la variable CC (Classeur Copie)

Application.ScreenUpdating = False 'masque les rafraîchissement d'écran
Set CS = ThisWorkbook 'définit le classeur source CS
CA = CS.Path & "\" 'définit le chemin d'accès CA
Set OS = CS.Worksheets("Feuil1") 'définit l'onglet source OS
Set PL = OS.Range("A1").CurrentRegion 'définit la plage PL
TV = PL 'd;efinit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeur TV (en partant de la seconde)
    D(TV(I, 1)) = "" 'aliment ele dictionnaire D avec les données en colonne 1 de TV
Next I 'prochane ligne de la boucle
TMP = D.keys 'récupère dans le tableau temmporaire TMP la liste des éléments du dictionnaire D sans doublon
ReDim OD(1 To D.Count) 'redimensionne le tableau des onglets destination
For I = 0 To UBound(TMP) 'boucle sur tous les éléments du tableau temporaire TMP
    If OS.FilterMode = True Then OS.ShowAllData 'si l'onglet OS est filtré, affiche toutes les données
    OS.Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=TMP(I) 'filtre la colonne A par rapport au ctritère TMP(I)
    OS.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:="O" 'filtre la colonne B par rapport au ctritère "O"
    OS.Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:="O" 'filtre la colonne C par rapport au ctritère "O"
    Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
    Set OD(I + 1) = ActiveSheet 'de'finit l'onglet destination OD(I)
    OD(I + 1).Name = "Critère " & TMP(I) 'renome l'onglet
    OS.Range(PL.Address).Copy OD(I + 1).Range("A1") 'copy la plage PL de l'onglet source et la colle dans A1 de l'onglet destination
Next I 'prochaie élément de la boucle
If OS.FilterMode = True Then OS.ShowAllData 'si l'onglet OS est filtré, affiche toutes les données
Application.DisplayAlerts = False 'n'affiche pas les messages Excel
For I = CS.Sheets.Count To 2 Step -1 'boucle inversée sur tous les onglets du classeur (du dernier au second)
    CS.Worksheets(I).Copy 'crée un nouveau classeur avec l'onglet de la boucle
    ActiveWorkbook.SaveAs CA & CS.Worksheets(I).Name, 51 'renregiste le classeur sous
    Set CC = ActiveWorkbook 'définit la classeur copie CC
    CC.Close False 'ferme le classeur CC
    CS.Worksheets(I).Delete 'suprime l'onglet de la boucle du classeur source
Next I 'prochaine onglet de la boucle
Application.DisplayAlerts = True 'affiche les messages d'excel
Application.ScreenUpdating = True 'affiche les rafraîchissement d'écran
MsgBox "Données traitées !" 'message de fin
CS.Save 'enregister le classeur source
End Sub

[Édition]

Bonjour Fred, nos posts se sont croisés...

Bonjour Tautheme,

Je te remercie grandement; une deuxième solution est toujours la bienvenue !

Je vais creuser un peu pour voir comment fonctionne le code ci-dessous, il est vrai que pour moi novice en VBA, le fait de commenter toutes les lignes afin de comprendre leurs fonctionnenent est très très bienvenue.

Merci

Bonne journée

Simon

Bonjour

en essai... de ce que j'ai compris... appuie sur le bouton bleu pour lancement de la macro...

Par manque d'information de ta part... les fichiers créés sont dans un sous dossier par rapport ou se trouve le fichier qui va exécuter la macro... ce dossier s'appel "export" et il est créé par macro si le dossier n'existe pas...

Fred

Re bonjour Fred,

Après plusieurs tentatives afin d'adapter ta VBA a mon besoin réelle je finit sur un échec...

En fait dans le même principe que le fichier créé, je voudrais renvoyer toutes les lignes quand la colonne "AM" =O et "AN" =O

C'est exactement ce que tu m'avais fait sauf que je voudrais que ça renvois (dans les fichiers créer) toutes les infos présentent dans les autres colonnes pour un numéro (colonne A) quand Critère1 = O et (colonne AM) et critère 2 =O (colonne AN)

Ci-joint mon exemple plus concret.

24test.xlsm (152.68 Ko)

Je te remercie d'avance si tu sais comment adapter ta VBA a plusieurs colonne, j'ai chercher et a chaque fois je fait planter le fichier.

Très bonne soirée et bon week end

Simon

re

Salut ThauTheme

Il aurait été préférable de donner ce fichier dès le départ.... cela aurait évité de faire 2 fois le boulot....

ci joint donc une nouvelle version avec le code commenté..

Fred

33test-2.xlsm (159.37 Ko)

re

Salut ThauTheme

Il aurait été préférable de donner ce fichier dès le départ.... cela aurait évité de faire 2 fois le boulot....

ci joint donc une nouvelle version avec le code commenté..

Fred

Bonjour Fred,

Alors c'est parfait, je suis désolé pour le fichier, je voulais au départ juste une piste pour essayer de le faire moi même. En fait je me suis sur-estimé.

Tout va bien , les fichiers se créent correctement avec le bon nom. Par contre les nouveau fichiers sont vide, les données qui sont dans les colonnes ne s'affiche dans les nouveau fichier ? Est ce que tu sais d'ou pourrais venir ce problème ?

Ah et au top le code commenté ça m'aide à comprendre comment ça fonctionne.

Très bonne journée

Simon

Bonjour

je ne sais pas pourquoi cela fait cela... il faut visiblement activer la feuille où se trouve la tableau...

Voici donc un nouveau fichier avec a priori le fonctionnement OK... j'ai juste ajouter un

ws.activate... 

Fred

68test-3.xlsm (159.42 Ko)

Bonjour

je ne sais pas pourquoi cela fait cela... il faut visiblement activer la feuille où se trouve la tableau...

Voici donc un nouveau fichier avec a priori le fonctionnement OK... j'ai juste ajouter un

ws.activate... 

Fred

Salut Fred parfait, j'arrive à faire mon petit truc avec tes explications c'est top. Je te remercie grandement.

Juste pour infos avant de clôturer, comment je peux faire pour indiquer un chemin si je veux que les fichier se créer autre part que a la racine du fichier existant ?

Simon

Bonsoir

Ici remplace :

'ou sera dans un sous dossier nommé export
 sFolderName = sPath & "export" & Application.PathSeparator

par exemple :

sFolderName = "C:\Users\PC-Fred-W7\Downloads\"

Attention à bien mettre le \ à la fin....

Fred

Bonsoir

Ici remplace :

'ou sera dans un sous dossier nommé export
 sFolderName = sPath & "export" & Application.PathSeparator

par exemple :

sFolderName = "C:\Users\PC-Fred-W7\Downloads\"

Attention à bien mettre le \ à la fin....

Fred

Salut fred

Parfait je te remercie,

Sujet parfaitement résolu,

Bonne fin de journée !

Rechercher des sujets similaires à "creation macro creer fichiers"