Bonjour à tous,

J'espère que je suis sur le bon forum....
je débute en VBA mais je cherche le moyen d'agregger (je ne sais pas si c'est le terme exact) plusieurs classeurs dans un classeur récap. jusque là pas très compliqué. J'arrive avec la formule suivante à récupérer les lignes qui m'intéressent dans un classeur et les écrire dans un autre dans les bonnes colonnes.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
Dim ClasseurMaitre
Sub ConsolideArborescence()
  Application.ScreenUpdating = False
  ClasseurMaitre = ThisWorkbook.Name
  repertoire = ThisWorkbook.Path
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set DossierRacine = fs.getfolder(repertoire)
  Lit_dossier DossierRacine, 1
End Sub
 
Sub Lit_dossier(ByRef dossier, ByVal niveau)
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
   Next
   For Each f In dossier.Files
     nf = f.Name
     If nf <> ClasseurMaitre Then
       Workbooks.Open Filename:=dossier & "\" & nf
       [A2].Copy Workbooks(ClasseurMaitre).Sheets(1).[C3].End(xlUp).Offset(1, 0)
       [B2].Copy Workbooks(ClasseurMaitre).Sheets(1).[G3].End(xlUp).Offset(1, 0)
       [C2].Copy Workbooks(ClasseurMaitre).Sheets(1).[K3].End(xlUp).Offset(1, 0)
       ActiveWorkbook.Close False
     End If
   Next
End Sub
J'ai essayé ça également qui semble plus proche mais ça ne donne rien

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 
Dim ClasseurMaitre
Sub ConsolideArborescence()
  Application.ScreenUpdating = False
  ClasseurMaitre = ThisWorkbook.Name
  repertoire = ThisWorkbook.Path
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set DossierRacine = fs.getfolder(repertoire)
  Lit_dossier DossierRacine, 1
End Sub
 
Sub Lit_dossier(ByRef dossier, ByVal niveau)
   Dim strCellule
   Dim i As Integer
   Dim str As String
   i = 3
   str = "C"
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
 
     For Each f In dossier.Files
        nf = f.Name
        If nf <> ClasseurMaitre Then
        Workbooks.Open Filename:=dossier & "\" & nf
        g = 0
        k = 0
        strCellule = str & i
        g = "G" & i
        k = "K" & i
            [A2].Copy Workbooks(ClasseurMaitre).Sheets(1).[C6].End(xlUp).Offset(1, 0)
            [B2].Copy Workbooks(ClasseurMaitre).Sheets(1).[g].End(xlUp).Offset(1, 0)
            [C2].Copy Workbooks(ClasseurMaitre).Sheets(1).[k].End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close False
        End If
      Next
    i = i + 1
    Next
End Sub
Mon seul problème c'est que chaque classeur correspond à une ligne de mon fichier maitre.
Pour une date, admettons le 15/10/09, je récupére l'info X, Y et Z depuis le fichier info1.xls
Pour le 16/10/09, je voudrais récupérer les mêmes infos X, Y et Z depuis le fichier info2.xls et ainsi de suite

Mes fichiers info.xls ont des noms incrémentés chaque jour.

Il faudrait que j'arrive à dire que info1 est le fichier de départ et qu'il doit écrire dans la ligne de départ +1

En gros j'ai 365 fichiers, de info1.xls à info 365.xls qui chacun correspondent à une date.

Je ne sais pas si je suis clair (à priori non) mais j'espère que vous pourrez m'aider

Thomas