Création macro, pour créer plusieurs fichiers Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
simonstransport
Jeune membre
Jeune membre
Messages : 13
Inscrit le : 30 janvier 2019
Version d'Excel : Microsoft Excel 2010

Message par simonstransport » 6 février 2020, 17:21

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.
Test.xlsx
(8.08 Kio) Téléchargé 9 fois
Avatar du membre
fred2406
Membre impliqué
Membre impliqué
Messages : 2'229
Appréciations reçues : 47
Inscrit le : 13 mai 2014
Version d'Excel : O365Pro-2019-2011MAC
Version de Calc : 6.3

Message par fred2406 » 7 février 2020, 11:27

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
test.xlsm
(21.24 Kio) Téléchargé 4 fois
Modifié en dernier par fred2406 le 7 février 2020, 11:30, modifié 1 fois.
Je ne réponds pas aux M.P. non sollicités.
Ne pas oublier :
:btres:
Fred :O-O:
Avatar du membre
ThauThème
Passionné d'Excel
Passionné d'Excel
Messages : 4'047
Appréciations reçues : 212
Inscrit le : 19 octobre 2014
Version d'Excel : 2010 FR

Message par ThauThème » 7 février 2020, 11:29

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...
À plus,

ThauTheme


Je suis Charlie
VBA m'éclate, les formules m'ennuient ! Je n'y peux rien c'est comme ça...
Avatar du membre
simonstransport
Jeune membre
Jeune membre
Messages : 13
Inscrit le : 30 janvier 2019
Version d'Excel : Microsoft Excel 2010

Message par simonstransport » 7 février 2020, 14:08

fred2406 a écrit :
7 février 2020, 11:27
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
Avatar du membre
simonstransport
Jeune membre
Jeune membre
Messages : 13
Inscrit le : 30 janvier 2019
Version d'Excel : Microsoft Excel 2010

Message par simonstransport » 7 février 2020, 14:23

ThauThème a écrit :
7 février 2020, 11:29
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
Avatar du membre
simonstransport
Jeune membre
Jeune membre
Messages : 13
Inscrit le : 30 janvier 2019
Version d'Excel : Microsoft Excel 2010

Message par simonstransport » 7 février 2020, 16:44

fred2406 a écrit :
7 février 2020, 11:27
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.
test.xlsm
(152.68 Kio) Téléchargé 7 fois
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
Avatar du membre
fred2406
Membre impliqué
Membre impliqué
Messages : 2'229
Appréciations reçues : 47
Inscrit le : 13 mai 2014
Version d'Excel : O365Pro-2019-2011MAC
Version de Calc : 6.3

Message par fred2406 » 7 février 2020, 19:08

re
Salut ThauTheme
Il aurait été préférable de donner ce fichier dès le départ.... 8[] 8[] 8[] cela aurait évité de faire 2 fois le boulot.... :oops: :oops:
ci joint donc une nouvelle version avec le code commenté..
Fred
test (2).xlsm
(159.37 Kio) Téléchargé 4 fois
Je ne réponds pas aux M.P. non sollicités.
Ne pas oublier :
:btres:
Fred :O-O:
Avatar du membre
simonstransport
Jeune membre
Jeune membre
Messages : 13
Inscrit le : 30 janvier 2019
Version d'Excel : Microsoft Excel 2010

Message par simonstransport » 17 février 2020, 09:54

fred2406 a écrit :
7 février 2020, 19:08
re
Salut ThauTheme
Il aurait été préférable de donner ce fichier dès le départ.... 8[] 8[] 8[] cela aurait évité de faire 2 fois le boulot.... :oops: :oops:
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
Avatar du membre
fred2406
Membre impliqué
Membre impliqué
Messages : 2'229
Appréciations reçues : 47
Inscrit le : 13 mai 2014
Version d'Excel : O365Pro-2019-2011MAC
Version de Calc : 6.3

Message par fred2406 » 17 février 2020, 19:46

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
test (3).xlsm
(159.42 Kio) Téléchargé 5 fois
Je ne réponds pas aux M.P. non sollicités.
Ne pas oublier :
:btres:
Fred :O-O:
Avatar du membre
simonstransport
Jeune membre
Jeune membre
Messages : 13
Inscrit le : 30 janvier 2019
Version d'Excel : Microsoft Excel 2010

Message par simonstransport » 18 février 2020, 09:53

fred2406 a écrit :
17 février 2020, 19:46
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
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message