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

 

[Romuald73]

Hello Robert

J'ai re-essayé ailleurs et ça me donne le message d'erreur en pj tout en surlignant la ligne (merci pour la reco du F8 ! )
" For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)"

Bonne soirée

Sébastien

 

[Robert]

Re,

Désolé, quand je t'ai proposé de ne plus ouvrir les fichiers je me suis bien mélangé les pinceaux en déplaçant une partie du code. Essaie avec ce code modifié :

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 CA As String 'déclare la variable CA (Chemin d'Accès)
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 OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
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
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) 'définit le tableau des valeurs TV
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 1 : si le nom du fichier n'est pas le nom de ce fichier
  If DEST.Row > 6 Then 'condition 2 : si la ligne de DEST est supérieure à 6 )il y a au moins un fichier dans le tableau)
  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
  End If 'fin de la condition 2
  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)
  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 valeurs de la plage AR2:BK2 de l'onglet source DEST, redimensionnée, décalé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]

Pas de souci Robert merci pour cet update. En revanche je ne peux pas copier/coller la macro car il m'affiche "mémoire insuffisante" je ne sais pas s'il y a un moyen (subdiviser la macro ou autre ?)

Un grand merci encore pour tout

 

[Robert]

Re,

La macro en elle même est très courte. Seul le tableau TV peut poser problème si il est vraiment très très grand mais je ne sais pas combien de fichiers tu vas récupérer. Il m'est arriver d'avoir ce message. J'ai fermé Excel, redémarrer et ça fonctionnait...

 

[Romuald73]

Re,

La macro en elle même est très courte. Seul le tableau TV peut poser problème si il est vraiment très très grand mais je ne sais pas combien de fichiers tu vas récupérer. Il m'est arriver d'avoir ce message. J'ai fermé Excel, redémarrer et ça fonctionnait...

Merci Robert pour ton temps et ces éléments. Je regarderai.

 

[Romuald73]

Re,

Désolé, quand je t'ai proposé de ne plus ouvrir les fichiers je me suis bien mélangé les pinceaux en déplaçant une partie du code. Essaie avec ce code modifié :

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 CA As String 'déclare la variable CA (Chemin d'Accès)
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 OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
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
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) 'définit le tableau des valeurs TV
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 1 : si le nom du fichier n'est pas le nom de ce fichier
  If DEST.Row > 6 Then 'condition 2 : si la ligne de DEST est supérieure à 6 )il y a au moins un fichier dans le tableau)
  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
  End If 'fin de la condition 2
  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)
  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 valeurs de la plage AR2:BK2 de l'onglet source DEST, redimensionnée, décalé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

Bonjour Robert,

Ca y est j'ai pu essayer la macro que tu as modifiée (merci)mais elle ne récupère que les données source d'un seul fichier sur les 3 que j'ai mises dans le dossier. IL doit y avoir une erreur au niveau du code maais je suis bien incapable de l'identifier.

Une idée ?

A +
Romu

 

[Romuald73]

Bonjour Robert,

Ca y est j'ai pu essayer la macro que tu as modifiée (merci)mais elle ne récupère que les données source d'un seul fichier sur les 3 que j'ai mises dans le dossier. IL doit y avoir une erreur au niveau du code maais je suis bien incapable de l'identifier.

Une idée ?

A +
Romu

Pour être plus précis: il faut que j'active autant de fois la macro qu'il y a de fichiers pour que ça marche. Y aurait-il un moyen pour faire en sorte (comme c'était le cas avec la première macro) qu'il compile avec un seul clic STP ? Merci

 

[Robert]

Re,

Oui désolé. Je n'ai pas testé avant d'envoyer et il y avait une erreur. Le nouveau et j'espère dernier code :

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 CA As String 'déclare la variable CA (Chemin d'Accès)
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 OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
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
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) 'définit le tableau des valeurs TV
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 1 : si le nom du fichier n'est pas le nom de ce fichier
  If DEST.Row > 6 Then 'condition 2 : si la ligne de DEST est supérieure à 6 )il y a au moins un fichier dans le tableau)
  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
  End If 'fin de la condition 2
  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)
  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 valeurs de la plage AR2:BK2 de l'onglet source DEST, redimensionnée, décalée d'une colonne à droite
  CS.Close False 'ferme le classeur source sans enregistrer
  End If 'fin de la condition
suite: 'étiquette
  F = Dir 'définit le prochain fichier ayant CA comme chemin d'accès
Loop 'boucle
End Sub