Aggréger des données provenant de plusieurs classeurs

euskal64 Messages postés 3 Statut Membre -  
euskal64 Messages postés 3 Statut Membre -
Bonjour à tous et à toutes,

Je suis actuellement entrain d'essayer de comprendre comment je pourrais agréger plusieurs données provenant de classeurs différents. je vais essayer de faire un résumé simplifié de mon problème pour que vous puissiez comprendre et essayer de m'aiguiller/m'aider :

Tous mes classeurs ont été rassemblé dans le même dossier " c:\BDD\"
- Chaque classeurs contient énormement de données avec pour chaque classeur un nombre différent de colones et de ligne.

Ce que je souhaite faire c'est :

- Récupérer certaines données sur chacun des classeurs, par exemple sur chaque classeur la colonne "titre" existe mais à un emplacement différents sur chaque classeurs , par exemple la colonne "titre" est dans la colonne "A1" sur le Book1 et sur la colonne G1 "sur le Book2" ( c'est à titre d'exemple) .
- Donc j'aimerais récupérer les données que contiennent chacune de ces colonnes et les agréger dans une colonne "Titre" sur un document de synthèse, donc les données seront mises à la suite les unes des autres.
- Je dois répeter cette action sur plusieurs colonnes ( "titre", "domaine", "durée", ...) en suivant ce même principe.

J'ai mis en un document qui represente la structure de mes classeurs pour que vous puissiez mieux visualiser sur cjoint ( https://www.cjoint.com/?0BzoQWDPqBG ).
Par contre je tiens à preciser que chaque feuille represente un "classeur ".

Je vous remercie par avance pour votre aide
Cordialement.
A voir également:

2 réponses

via55 Messages postés 14730 Date d'inscription   Statut Membre Dernière intervention   2 751
 
Bonsoir

A condition que les classeurs aient bien le même nom avec un indice différent et que les feuilles où sont les données aient elles aussi un nom identique voilà une macro qui pourrait recopier les données des colonnes Titre (tous les classeurs étant ouverts)

A adapter en fonction des fichiers réels

A copier en changeant la variable intitule pour les autres données

Cordialement
0
via55 Messages postés 14730 Date d'inscription   Statut Membre Dernière intervention   2 751
 
Sub recopie()
nb = 5 'nombre de classeurs à adapter
nomf = "Feuil 1" 'nom de la feuille identique de chaque classeur où trouver les donnees
nomsynt = "Synthese" 'nom du classeur de synthese
intitule = "Titre"
xl = 1
For n = 1 To nb
nomcl = "Book" & n 'nom du classeur source
For j = 1 To 10 ' boucle colonne 1 à 10 sur la ligne 1 des intitulés à adapter
If Workbooks(nomcl).Sheets(nomf).Cells(1, j).Value = intitule Then ncol = j: Exit For
Next j
MsgBox ncol
der = Workbooks(nomcl).Sheets(nomf).Cells(1, ncol).End(xlDown).Row ' N° ligne de la derniere cellule non vide de la colonne ncol
For t = 2 To der 'boucle de la ligne 2 à n° derniere ligne non vide pour recopie
xl = xl + 1
Workbooks(nomsynt).Sheets(nomf).Cells(xl, 1).Value = Workbooks(nomcl).Sheets(nomf).Cells(t, ncol).Value
Next t
Next n
End Sub

j'avais validé avant de coller la macro !!!
0
euskal64 Messages postés 3 Statut Membre
 
Merci beaucoup pour ton aide je vais te tester ça
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
Bonjour Euskal64
au Pays Basque Nord ;o)

une alternative peut-^tre + rapide
dans ton dossier source, il faut qu'il n'y ait que ces derniers et à la rigueur le classeur synthèse (le nom est indifférent pour la macro de m^me que les classeurs source)

Option Explicit   
Option Base 1   
Sub extraire_books()   
Dim Dercol As Byte, Fich As String   
Dim T_ordre(), T_out()   
Dim Derlig As Long, Col As Byte, Lig As Long, Cptr As Byte, Ligvid As Long   

Application.ScreenUpdating = False   

With ThisWorkbook.ActiveSheet   
     'nettoie le tableau   
     .Range("A2:H65000").Clear   
     'mémorise l'ordre de restitution des champs   
     Dercol = .Rows(1).Find("*", , , , , xlPrevious).Column 
     T_ordre = .Range(.Cells(1, "A"), .Cells(1, Dercol)).Value   
     ReDim T_out(Dercol, 1)   
End With   

'le dossier des souce devient le dossier actif   
ChDir "D:\documents\ccm" '  A ADAPTER   
Fich = Dir("*.xls")   

'parcours le dossier   
While Fich <> ""   
     If Fich <> ThisWorkbook.Name Then   
     Workbooks.Open Fich   
          With ActiveSheet   
               'dernière mligne occupée   
               Derlig = .Cells.Find("*", , , , , xlPrevious).Row   
               'mémorise la taille des données à transfèrer   
               ReDim Preserve T_out(Dercol, Derlig)   
               For Cptr = 1 To Dercol   
                    'recherche la position du champ dans le fichier source   
                    Col = Rows(1).Find(T_ordre(1, Cptr)).Column   
                    For Lig = 2 To Derlig   
                         T_out(Cptr, Lig - 1) = .Cells(Lig, Col)   
                    Next Lig   
               Next Cptr   
          End With   
      ActiveWorkbook.Close   
      'restitution   
      With ThisWorkbook.ActiveSheet   
          Ligvid = .Columns("A").Find("").Row   
          With .Cells(Ligvid, "A").Resize(Derlig, Dercol)   
               .Value = Application.Transpose(T_out)   
               .Borders.Weight = xlThin   
          End With   
      End With   
     End If   
     'recherche le fichier suivant   
     Fich = Dir   
Wend   
End Sub   

edit 12:20 modifié affectation Dercol

Michel
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
..... DE RIEN, Euskal64
0
euskal64 Messages postés 3 Statut Membre
 
Bonjour Michel_m ,

Tout d'abord désolé pour ma réponse en retard j'étais en vacance donc j'ai pas eu le temps de vérifier les réponses sur le forum :s
En tout cas merci pour essayer de m'aider je vais essayer ta solution et de l'adapter à mes besoin je reviendrais vers vous pour vous dire comment ça c'est passé.
Merci d'avoir pris le temps de me répondre en tout cas ;)
0