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.
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 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
Mon seul problème c'est que chaque classeur correspond à une ligne de mon fichier maitre.
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
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
Partager