Exportation de données Excel vers un autre fichier

[Constantin]

Bonjour,
J'ai beau chercher, je n'arrive pas à grand chose... Si quelqu'un peut m'aider?
Je dispose de plusieurs (150) fichiers sources, tous élaborés à partir du même xtlm. Cela génère donc des fichiers sources (xlsm) qui seront tous stockés dans le même répertoire. Je voudrais extraire les données d'une feuille source (colonne) pour les importer dans un fichier de synthèse. Pour ne pas compliquer les choses, j'ouvre en même temps un fichier source et le fichier synthèse. Je voudrais pouvoir exporter les données d'une colonne d'une feuille définie vers le fichier synthèse. Je répèterai l'opération avec chaque fichier source, le tout étant pour moi de collecter les données exportées dans le fichier synthèse en positionnant les colonnes les unes à côté des autres pour pouvoir ensuite procéder à des analyses de ces données regroupées dans une même feuille. Chaque fichier source contiendrait une macro qui transposerait automatiquement les données automatiquement sélectionnées vers la feuille du fichier synthèse en positionnant les données exportées de colonne en colonne sans écraser les données précédemment enregistrées à partir des autres fichiers sources. Comme je vais recevoir les fichiers sources (xlsm) au fil du temps, je n'ai pas besoin d'une macro qui vienne ouvrir tous les fichiers en même temps. Je voudrais, à partir du modèle xltm, construire une macro qui se retrouvera disponible dans chaque chaque fichier xlsm et qui me permettra d'envoyer les données sur mon fichier synthèse...
Je vous jure, ça fait 10 jours que je suis sur ce problème et je n'arrive à rien. Quand on n'est pas bon, on n'est pas bon!

Mille mercis si vous avez une idée.

Tous mes vœux à cette formidable équipe de développeurs que vous êtes.

Constantin

 

[Robert]

Bonjour Constantin, bonjour le forum,

Beau laïus pour finalement très peu de renseignements utiles. Tu adapteras...

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim COL As Integer 'déclare la variable COL (COLonne)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination (à adapter ici le premier onglet)
CA = "ici tu mets le chemin d'accès aux fichiers source avec un \ à la fin" 'à adapter à ton cas
F = Dir(CA & "*.xlsm") 'définit le premier fichier .xlsm ayant CA comme chemin d'accès
COL = 1 'initialise la variable COL (à adapter  ici la première colonne)
Do While F <> "" 'exécute tant qu'il existe des fichiers .xlsm
  Workbooks.Open (CA & F) 'ouvre le fichier
  Set CS = ActiveWorkbook 'définit le classeur source CS
  Set OS = CS.Worksheets(1) 'définit l'onglet source (à adapter ici le premier onglet)
  OS.Columns(1).Copy OD.Columns(COL) 'copie la première colonne (à adapter) de l'onglet source et la colle dans la colonne COL de l'onglet destination
  COL = COL + 1 'incrémente la colonne COL
  CS.Close False 'ferme le classeur source sans enregistrer
  F = Dir 'définit le fichier .xlsm suivant ayany CA comme chemin d'accès
Loop 'boucle
End Sub

 

[Constantin]

Bonjour Constantin, bonjour le forum,

Beau laïus pour finalement très peu de renseignements utiles. Tu adapteras...

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim COL As Integer 'déclare la variable COL (COLonne)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination (à adapter ici le premier onglet)
CA = "ici tu mets le chemin d'accès aux fichiers source avec un \ à la fin" 'à adapter à ton cas
F = Dir(CA & "*.xlsm") 'définit le premier fichier .xlsm ayant CA comme chemin d'accès
COL = 1 'initialise la variable COL (à adapter  ici la première colonne)
Do While F <> "" 'exécute tant qu'il existe des fichiers .xlsm
  Workbooks.Open (CA & F) 'ouvre le fichier
  Set CS = ActiveWorkbook 'définit le classeur source CS
  Set OS = CS.Worksheets(1) 'définit l'onglet source (à adapter ici le premier onglet)
  OS.Columns(1).Copy OD.Columns(COL) 'copie la première colonne (à adapter) de l'onglet source et la colle dans la colonne COL de l'onglet destination
  COL = COL + 1 'incrémente la colonne COL
  CS.Close False 'ferme le classeur source sans enregistrer
  F = Dir 'définit le fichier .xlsm suivant ayany CA comme chemin d'accès
Loop 'boucle
End Sub

 

[Constantin]

Bonjour Robert,
Merci de la rapidité de la réponse... Mais je galère!
Je me propose de vous envoyer mes fichiers (source.xlsm + Export.xlsx)
Les cellules à exporter sont contenus dans les onglets évaluation1, 2 et 3 pour les placer respectivement dans les onglets Evaluation1,2 et 3 du fichier Export.
Je vais encore essayer d'adapter le code à mes fichiers en espérant y arriver.
Mille mercis pour votre aide !
Constantin

 

[Robert]

Re,

Donne-nous le chemin d'accès des fichiers source et je t'adapterai le code...

 

[Robert]

Re,

Le code modifié (toujours le chemin d'accès à adapter à ton cas) :

Sub Macro1()
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim OS As Variant 'déclare la variable OS (Onglets Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim F As String 'déclare la variable F (Fichier)
Dim COL As Integer 'déclare la variable COL (COLonne)

CA = "ici tu mets le chemin d'accès aux fichiers source avec un \ à la fin" 'à adapter à ton cas
OS = Array("Evaluation1", "Evaluation2", "Evaluation3") 'définitle tableau des onglets OS
Set CD = ThisWorkbook 'définit le classeur destination CD
F = Dir(CA & "*.xlsm") 'définit le premier fichier .xlsm ayant CA comme chemin d'accès
COL = 5 'initialise la variable COL
Do While F <> "" 'exécute tant qu'il existe des fichiers .xlsm
  Workbooks.Open (CA & F) 'ouvre le fichier
  Set CS = ActiveWorkbook 'définit le classeur source CS
  For I = 0 To 2 'boucle sur les 3 éléments du tableau des onglets OS
  CS.Worksheets(OS(I)).Columns(5).Copy CD.Worksheets(I + 1).Columns(COL) 'copie la cinquième colonne de l'onglet source et la colle dans la colonne COL de l'onglet destination
  Next I 'prochain élément de la boucle
  COL = COL + 1 'incrémente la colonne COL
  CS.Close False 'ferme le classeur source sans enregistrer
  F = Dir 'définit le fichier .xlsm suivant ayany CA comme chemin d'accès
Loop 'boucle
End Sub

 

[Constantin]

Rebonjour Robert
Le chemin d'accès au répertoire n'est pas encore défini. Cela devrait ressembler à quelque chose comme ça que j'essayerai d'adapter:
I:\Phisp\EHPAD\Autoévaluation 2019.
Comme je vous l’écrivais (sans doute maladroitement dans mon premier message), je voudrais intégrer ma macro d'exportation pour chaque fichier source(1 à n).xlsm en sachant que le nom du fichier est généré automatiquement dans l'onglet IdentificationSSIAD. Je sais, c'est un peu une usine à gaz mais je n'ai pas su faire mieux. Il n'est pas utile pour moi de définir une routine qui rechercherait tous les fichiers du répertoire dans la mesure où les fichiers envoyés par les établissements arriveront au compte-goutte. Par contre, à défaut de faire un copier coller de façon manuelle des données Evaluation1, 2 et 3 des fichiers sources, une macro d'exportation contenue dans chaque feuille d'évaluation en direction du fichier export me simplifierait grandement le travail. Mais peut-être suis-je trop gourmand?
Si vous souhaitez me contacter au téléphone, bien que ce ne soit pas dans les us de Download, il n'y a aucun problème pour moi.

Bien cordialement,

CONSTANTIN

 

[Robert]

Re,

[Édition] j'avais mal lu... je revois ma copie.

 

[Robert]

Re,

Ce code, a placer dans les classeurs source, marchera si le classeur destination est ouvert :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OS As Variant 'déclare la variable OS (Onglets Source)
Dim COL As Integer 'déclare la variable COL (COLonne)

Set CS = ThisWorkbook 'définit le classeur source CS
Set CD = Workbooks("export.xlsx") 'définit le classeur destination CD
OS = Array("Evaluation1", "Evaluation2", "Evaluation3") 'définit le tableau des onglets OS
COL = CD.Worksheets(1).Cells(5, 1).End(xlToRight).Column + 1
For I = 0 To 2 'boucle sur les 3 éléments du tableau des onglets OS
  CS.Worksheets(OS(I)).Columns(5).Copy CD.Worksheets(I + 1).Columns(COL) 'copie la cinquième colonne de l'onglet source et la colle dans la colonne COL de l'onglet destination
Next I 'prochain élément de la boucle
CS.Close False 'ferme le classeur source sans enregistrer
End Sub

 

[Constantin]

Bonjour,
J'ai beau chercher, je n'arrive pas à grand chose... Si quelqu'un peut m'aider?
Je dispose de plusieurs (150) fichiers sources, tous élaborés à partir du même xtlm. Cela génère donc des fichiers sources (xlsm) qui seront tous stockés dans le même répertoire. Je voudrais extraire les données d'une feuille source (colonne) pour les importer dans un fichier de synthèse. Pour ne pas compliquer les choses, j'ouvre en même temps un fichier source et le fichier synthèse. Je voudrais pouvoir exporter les données d'une colonne d'une feuille définie vers le fichier synthèse. Je répèterai l'opération avec chaque fichier source, le tout étant pour moi de collecter les données exportées dans le fichier synthèse en positionnant les colonnes les unes à côté des autres pour pouvoir ensuite procéder à des analyses de ces données regroupées dans une même feuille. Chaque fichier source contiendrait une macro qui transposerait automatiquement les données automatiquement sélectionnées vers la feuille du fichier synthèse en positionnant les données exportées de colonne en colonne sans écraser les données précédemment enregistrées à partir des autres fichiers sources. Comme je vais recevoir les fichiers sources (xlsm) au fil du temps, je n'ai pas besoin d'une macro qui vienne ouvrir tous les fichiers en même temps. Je voudrais, à partir du modèle xltm, construire une macro qui se retrouvera disponible dans chaque chaque fichier xlsm et qui me permettra d'envoyer les données sur mon fichier synthèse...
Je vous jure, ça fait 10 jours que je suis sur ce problème et je n'arrive à rien. Quand on n'est pas bon, on n'est pas bon!

Mille mercis si vous avez une idée.

Tous mes vœux à cette formidable équipe de développeurs que vous êtes.

Constantin

 

[Constantin]

Bonsoir Robert,
Désolé de vous embêter à nouveau, mais rien ne marche... Cela m'efface toutes mes données dans mes fichiers sources et rien ne s'affiche (à part la date d'évaluation dans le fichier export). Je ne parle pas des messages de débogage.
Je vais donc le faire à la "main".
Désolé pour le temps que vous avez consacré à ma demande,

Bonne fin de semaine.

Constantin

 

[Constantin]

Désolé Robert,

Re,

Ce code, a placer dans les classeurs source, marchera si le classeur destination est ouvert :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OS As Variant 'déclare la variable OS (Onglets Source)
Dim COL As Integer 'déclare la variable COL (COLonne)

Set CS = ThisWorkbook 'définit le classeur source CS
Set CD = Workbooks("export.xlsx") 'définit le classeur destination CD
OS = Array("Evaluation1", "Evaluation2", "Evaluation3") 'définit le tableau des onglets OS
COL = CD.Worksheets(1).Cells(5, 1).End(xlToRight).Column + 1
For I = 0 To 2 'boucle sur les 3 éléments du tableau des onglets OS
  CS.Worksheets(OS(I)).Columns(5).Copy CD.Worksheets(I + 1).Columns(COL) 'copie la cinquième colonne de l'onglet source et la colle dans la colonne COL de l'onglet destination
Next I 'prochain élément de la boucle
CS.Close False 'ferme le classeur source sans enregistrer
End Sub

 

[Constantin]

Désolé Robert,
J'avais zappé votre dernière réponse.
J'emmène tout cela au bureau demain matin... Et je pense que ça devrait marcher.

Merci de votre patience, je vous tiens informé de mes avancées.

Bien cordialement,

 

[Constantin]

Bonjour Robert,
Je n'ai pas réussi ce matin... J'avais embarqué le mauvais code sur ma clé USB... Eh oui, mon administration bloquant les sources extérieures, je dois faire mes recherches à la maison et les emmener ensuite sur mon portable professionnel.
Promis, je m'y mets en fin de soirée ou au plus tard demain matin.
Bon week-end !
Constantin

 

[Constantin]

Re,

Ce code, a placer dans les classeurs source, marchera si le classeur destination est ouvert :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OS As Variant 'déclare la variable OS (Onglets Source)
Dim COL As Integer 'déclare la variable COL (COLonne)

Set CS = ThisWorkbook 'définit le classeur source CS
Set CD = Workbooks("export.xlsx") 'définit le classeur destination CD
OS = Array("Evaluation1", "Evaluation2", "Evaluation3") 'définit le tableau des onglets OS
COL = CD.Worksheets(1).Cells(5, 1).End(xlToRight).Column + 1
For I = 0 To 2 'boucle sur les 3 éléments du tableau des onglets OS
  CS.Worksheets(OS(I)).Columns(5).Copy CD.Worksheets(I + 1).Columns(COL) 'copie la cinquième colonne de l'onglet source et la colle dans la colonne COL de l'onglet destination
Next I 'prochain élément de la boucle
CS.Close False 'ferme le classeur source sans enregistrer
End Sub