Récupération des données de plusieurs fichiers dans un seul

[Romuald73]

Bonjour à tous,

Première fois que je m'inscris. J'ai vu qu'il y avait pas mal de caïds d'excel, j'avoue que ça m'impressione et j'espère que l'un d'entre vous pourra m'aider. A noter que je m'y connais un peu en excel mais pas du tout en VBA.

Cadre du besoin: des personnes vont compléter l'onglet "Training Request Template" d'un fichier. Elles vont ensuite chacune envoyer son fichier (qu'elles auront renommé) complété à une personne qui va devoir récupérer dans un seul méta fichier toutes les données complétées. A noter que plusieurs personnes feront ce travail de compilation. Ainsi chaque personne qui fera ce travail de compilation mettra les fichiers récupérés à un emplacement qui l'arrange.

Détail du besoin:
- agréger dans le méta fichier ("collection of request needs") en pièce jointe le contenu de cellules qui seront systématiquement situées de AR2 en BK2 de l'onglet nommé "Training Request Template" de plusieurs fichiers distincts comportant chacun un nom différent. Il y aura donc une ligne de complétée par fichier source
- faire en sorte que la première colonne du fichier ("collection of request needs") récupère le nom du fichier à partir duquel les données ont été récupérées
- permettre à l'utilisateur du fichier ("collection of request needs") d'indiquer l'emplacement contenant les fichiers dont il souhaite extraire/compiler les données

A noter qu'il pourra y avoir des centaines de fichiers dont il faudra récupérer les données donc il faudrait qu'à chaque fois que la personne active la macro ça rafraichisse le tableau en ajoutant autant de ligne qu'il y a eu de nouveaux fichiers source dans le dossier cible.

Un immense merci par avance

Romu

 

[Johan]

Salut,

Pour que ça marche il serait préférable que tous tes fichiers sources soient situés dans le même dossier/emplacement. Ainsi on pourra dire à la macro de récupérer le contenu de l'onglet "Training Request Template" pour chaque fichier excel rencontré. Est ce que c'est le cas ?

Que deviennent ces fichiers après avoir été récupérés dans ton fichier cible ? Ca risque vraiment de mouliner longtemps s'il faut à chaque fois refaire un traitement sur TOUS les fichiers. Le mieux serait de les déplacer dans une archive après traitement.

 

[Robert]

Bonjour Romuald, bonjour le forum,

Enregistrer le fichier avec le code ci-dessous (qui deviendra donc .xlsm) dans le même dossier que celui qui contient les autres fichiers et lancer la macro...

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 DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Feuil1") 'définit l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(Path & "*.xlsx") 'définit le premier fichier "xlsx" (extension à adapter à ton cas) du dossier ayant CA comme chemin d'accès
Do While F <> "" 'boucle tant quíl existe des fichiers
  If Not F = CD.Name Then 'condition : si le nom du fichier n'est pas le nom de ce fichier
  Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS (en l'ouvrant)
  Set OS = CS.Worksheets(1) 'définit l'onglet source (premier onglet du classeur source, à adapter à ton cas)
  Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD
  DEST.Value = F 'renvoie de nom du fichier dans DEST
  OS.Range("AR2:BK2").Copy DEST.Offset(0, 1) 'copie la plage AR2:BK2 de l'onglet source et la colle dans DEST décalée d'une colonne à droite
  CS.Close False 'ferme le classeur source sans enregistrer
  F = Dir 'définit le prochain fichier ayant CA comme chemin d'accès
  End If 'fin de la condition
Loop 'boucle
End Sub

[Édition]
Bonjour Johan nos posts se sont croisés...

 

[Romuald73]

Salut,

Pour que ça marche il serait préférable que tous tes fichiers sources soient situés dans le même dossier/emplacement. Ainsi on pourra dire à la macro de récupérer le contenu de l'onglet "Training Request Template" pour chaque fichier excel rencontré. Est ce que c'est le cas ?

Que deviennent ces fichiers après avoir été récupérés dans ton fichier cible ? Ca risque vraiment de mouliner longtemps s'il faut à chaque fois refaire un traitement sur TOUS les fichiers. Le mieux serait de les déplacer dans une archive après traitement.

Bonjour Johan,
Pour commencer je te remercie pour ton retour rapide. Oui en réponse à ta première question, dans l'idée tous les fichiers sources seront situés dans le même dossier (il y a juste le fait qu'il y aura plusieurs personnes chargées de récupérer les données intégrées dans des fichiers qu'ils mettront dans un emplacement de leur choix à définir (d'où l'idée de la possibilité pour chaque "collecteur" de choisir l'emplacement où il viendra mettre l'ensemble des fichiers sources qu'il récupèrera).
Pour répondre à ta seconde question: merci de ton alerte (en effet je pense que le mieux serait qu'une fois les données extraites ces fichiers sources soient intégrés dans un dossier archive) <- si une macro peut les y affecter c'est top sinon je demanderai aux "collecteurs" de faire la manip à la main.
Merci à toi
NB: j'ai intégré ta macro (merci!) et j'ai 3 remarques:
1) pour l'intégration du nom du fichier dans la première colonne ça fonctionne nickel
2) malheureusement pour les cellules collectées qui sont à droite il me met à chaque fois le message suivant: =#REF! <- sans doute dû au fait que mes cellules sources n'ont pas été complétées en écrivant directement dessus mais ce sont des formules. Par exemple en AR2 de mon fichier source j'ai la formule=G1, en AS2 j'ai la formule=G2, en AT1 j'ai la formule O1 (il n'y a pas de linéarité entre les formules)... Y aurait-il un moyen de modifier la macro pour que ça affiche la valeur de la cellule source ?
3) à chaque fois que j'applique la macro il m'ajoute une ligne avec toujours les données sources qu'il avait déjà intégré ce qui veut dire que sauf à ce que la personne pense à archiver le fichier source après avoir activé la macro il risque à chaque fois d'ajouter des lignes. Ce que je voudrais (si possible) c'est avoir une ligne par fichier. Je ne sais pas si on peut faire ça.

 

[Robert]

Quand je vous disait que je n'aurais pas dû prendre ces pilules d'invisibilité hein !...

 

[Romuald73]

Salut,

Pour que ça marche il serait préférable que tous tes fichiers sources soient situés dans le même dossier/emplacement. Ainsi on pourra dire à la macro de récupérer le contenu de l'onglet "Training Request Template" pour chaque fichier excel rencontré. Est ce que c'est le cas ?

Que deviennent ces fichiers après avoir été récupérés dans ton fichier cible ? Ca risque vraiment de mouliner longtemps s'il faut à chaque fois refaire un traitement sur TOUS les fichiers. Le mieux serait de les déplacer dans une archive après traitement.

Quand je vous disait que je n'aurais pas dû prendre ces pilules d'invisibilité hein !...

Oups Pardon Robert. C'est ta macro que j'ai utilisée et je te remercie pour ton soutien ! J'ai posté un commentaire suite à utilisation de ta macro. Si tu pouvais m'aider ce serait super. Merci encore

 

[Romuald73]

Bonjour Romuald, bonjour le forum,

Enregistrer le fichier avec le code ci-dessous (qui deviendra donc .xlsm) dans le même dossier que celui qui contient les autres fichiers et lancer la macro...

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 DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Feuil1") 'définit l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(Path & "*.xlsx") 'définit le premier fichier "xlsx" (extension à adapter à ton cas) du dossier ayant CA comme chemin d'accès
Do While F <> "" 'boucle tant quíl existe des fichiers
  If Not F = CD.Name Then 'condition : si le nom du fichier n'est pas le nom de ce fichier
  Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS (en l'ouvrant)
  Set OS = CS.Worksheets(1) 'définit l'onglet source (premier onglet du classeur source, à adapter à ton cas)
  Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD
  DEST.Value = F 'renvoie de nom du fichier dans DEST
  OS.Range("AR2:BK2").Copy DEST.Offset(0, 1) 'copie la plage AR2:BK2 de l'onglet source et la colle dans DEST décalée d'une colonne à droite
  CS.Close False 'ferme le classeur source sans enregistrer
  F = Dir 'définit le prochain fichier ayant CA comme chemin d'accès
  End If 'fin de la condition
Loop 'boucle
End Sub

[Édition]
Bonjour Johan nos posts se sont croisés...

Et en plus tu codes comme un chef (tes commentaires en vert sont très appréicables, merci)

 

[Robert]

Re,

Le code modifié. Je pense quand même qu'il serait préférable d'archiver les fichiers déjà fait plutôt que de faire patiner la macro...

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 DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Long 'déclare la varaible I (Incrément)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Feuil1") 'définit l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(Path & "*.xlsx") 'définit le premier fichier "xlsx" (extension à adapter à ton cas) du dossier ayant CA comme chemin d'accès
Do While F <> "" 'boucle tant qu'il existe des fichiers
  If Not F = CD.Name Then 'condition : si le nom du fichier n'est pas le nom de ce fichier
  Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS (en l'ouvrant)
  Set OS = CS.Worksheets(1) 'définit l'onglet source (premier onglet du classeur source, à adapter à ton cas)
  Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD
  TV = OD.Range("A5:A" & DEST.Row - 1).CurrentRegion 'définit le tableau des valeurs TV
  For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
  If TV(I, 1) = F Then GoTo suite 'si la donnée ligne I colonne 1 de TV est égale au fichier F, va l'étiquette suite
  Next I 'prochaine ligne de la boucle
  DEST.Value = F 'renvoie de nom du fichier dans DEST
  DEST.Offset(0, 1).Resize(1, 20).Value = OS.Range("AR2:BK2").Value 'récupere les valeur de la plage AR2:BK2 de l'onglet source DEST décalée redimensionnée d'une colonne à droite
  CS.Close False 'ferme le classeur source sans enregistrer
suite: 'étiquette
  F = Dir 'définit le prochain fichier ayant CA comme chemin d'accès
  End If 'fin de la condition
Loop 'boucle
End Sub

 

[Romuald73]

Hello Robert,

J'ai testé ça marche nickel. Un GRAND MERCI à toi !!
En plus, je ne sais pas si c'est exprès mais lorsque j'active la macro une deuxième fois alors que le fichier n'a pas été archivé, il ne créée pas de deuxième ligne redondante (conformément à mon besoin, merci) mais il ouvre le fichier source en question (ce qui , du coup, fait penser à l'archiver)

A bientôt peut-être

Sébastien

 

[Robert]

Re,

Arf non ! C'était pas fait exprès... Pour ne plus l'ouvrir :

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 DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Long 'déclare la varaible I (Incrément)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Feuil1") 'définit l'onglet destination OD
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(Path & "*.xlsx") 'définit le premier fichier "xlsx" (extension à adapter à ton cas) du dossier ayant CA comme chemin d'accès
Do While F <> "" 'boucle tant qu'il existe des fichiers
  If Not F = CD.Name Then 'condition : si le nom du fichier n'est pas le nom de ce fichier
  For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
  If TV(I, 1) = F Then GoTo suite 'si la donnée ligne I colonne 1 de TV est égale au fichier F, va l'étiquette suite
  Next I 'prochaine ligne de la boucle  Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS (en l'ouvrant)
  Set OS = CS.Worksheets(1) 'définit l'onglet source (premier onglet du classeur source, à adapter à ton cas)
  Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD
  TV = OD.Range("A5:A" & DEST.Row - 1).CurrentRegion 'définit le tableau des valeurs TV
  
  DEST.Value = F 'renvoie de nom du fichier dans DEST
  DEST.Offset(0, 1).Resize(1, 20).Value = OS.Range("AR2:BK2").Value 'récupere les valeur de la plage AR2:BK2 de l'onglet source DEST décalée redimensionnée d'une colonne à droite
  CS.Close False 'ferme le classeur source sans enregistrer
suite:  'étiquette
  F = Dir 'définit le prochain fichier ayant CA comme chemin d'accès
  End If 'fin de la condition
Loop 'boucle
End Sub

 

[Romuald73]

Merci Robert.
Malheureusement, pour une raison que j'ignore, alors que ça fonctionnait nickel ça ne fonctionne plus du tout. C'est à dire que la macro ne donne rien (aucune ligne ne se complète). C'est très étonnant. J'ai fait la démo tout à l'heure c'était impeccable et ensuite je me suis envoyé le fichier pour le faire ailleurs (en mettant donc mon fichier de recueil (que j'ai renommé Concatenation) dans le même dossier que les fichiers dont je voulais extraire les données mais rien ne se passe quand j'active la macro. Même chose sur mon ordi de départ qui fonctionne avec même version d'excellé, ça ne fonctionne plus. :-(
Ci-joint le fichier.
Aurais-tu une idée d'où pourrait venir le problème par hasard ?
Un grand merci à toi
Romu

 

[Robert]

Re,

As-tu vérifié l'extension des fichiers ? Le code va ouvrir les fichiers ayant une extension .xlsx...

 

[Romuald73]

Re,

As-tu vérifié l'extension des fichiers ? Le code va ouvrir les fichiers ayant une extension .xlsx...

Oui c'est toujours les mêmes extensions de fichier source que j'utilise (.xlsx).
J'ai fait comme avant j'ai mis le code dans un module et j'ai lancé mais il ne se passe rien. Du coup je ne comprends pas ce qui se passe.Je joins un screenshot de l'espace VB pour te permettre de visualiser (au cas où le problème viendrait de là) ?
Encore un grand merci pour ton temps et ton expertise

Romu

 

[Robert]

Re,

Il te faut enregistrer le fichier dans le même dossier avant de lancer la macro !...
Sinon, il te faut faire avancer la macro pas à pas avec la touche [F8] et voir ce qu'il se passe, ou ne se passe pas...

 

[Romuald73]

Re,

Il te faut enregistrer le fichier dans le même dossier avant de lancer la macro !...
Sinon, il te faut faire avancer la macro pas à pas avec la touche [F8] et voir ce qu'il se passe, ou ne se passe pas...

Merci pour ton retour Robert mais c'est ce que j'avais pourtant bien fait. Par ailleurs quand je fais F8 il me parcours pas à pas la macro jusqu'à la dernière ligne sans message d'erreur sauf qu'à la fin quand je regarde le tableau il n'a rien récupéré comme donnée. Du coup on revient à mon cas précédent: ça ne fait rien.
Désolé j'aurais aussi aimé que ça fonctionne.