VBA - compiler des données : boucler sur tous les onglets de plusieurs fichiers

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

J'aimerai récupérer dans données de plusieurs onglets dans plusieurs fichiers pour les coller dans un fichier récap (appelé dans mon code "compilation consolidation.xls"). Les données doivent s'incrémenter dans un tableau les unes à la suite des autres.
Il me semble que j'arrive à boucler sur les différents dossiers, mais pas sur les onglets.
J'ai l'impression d'etre près du but mais je bloque. Si quelqu'un pouvait m'aider je lui en serais reconnaissant.

Code:

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
Sub Récup_données()
pfile = ActiveWorkbook.Path & "\" & Range("b2") & "\" 'chemin du répertoire
nfile = Dir(pfile)
Dim i As Integer
Dim LFinTab As Integer
Dim CFinTab As Integer
Application.ScreenUpdating = False
 
Do Until nfile = ""
    For i = 1 To Worksheets.Count
        LFinTab = Range("B6000").End(xlUp).Row
        CFinTab = Range("Z9").End(xlUp).Column
        Workbooks("Consolidation compilation.xlsm").Worksheet("sheet1").Range("B" & LFinTab) = Workbooks(nfile).Worksheet("sheet" & i).Range("A6")
        Workbooks("Consolidation compilation.xlsm").Worksheet("sheet1").Range("C" & LFinTab) = Workbooks(nfile).Worksheet("sheet" & i).Range("A9")
        Workbooks("Consolidation compilation.xlsm").Worksheet("sheet1").Range("D" & LFinTab) = Workbooks(nfile).Worksheet("sheet" & i).Range(CFinTab & "8")
        Workbooks("Consolidation compilation.xlsm").Worksheet("sheet1").Range("E" & LFinTab) = Workbooks(nfile).Worksheet("sheet" & i).Range(CFinTab & "9")
 
        Workbooks("Consolidation compilation.xlsm").Worksheet("sheet1").Range("B" & LFinTab) = Workbooks(nfile).Worksheet("sheet" & i).Range("A6")
        Workbooks("Consolidation compilation.xlsm").Worksheet("sheet1").Range("C" & LFinTab) = Workbooks(nfile).Worksheet("sheet" & i).Range("A10")
        Workbooks("Consolidation compilation.xlsm").Worksheet("sheet1").Range("D" & LFinTab) = Workbooks(nfile).Worksheet("sheet" & i).Range(CFinTab & "8")
        Workbooks("Consolidation compilation.xlsm").Worksheet("sheet1").Range("E" & LFinTab) = Workbooks(nfile).Worksheet("sheet" & i).Range(CFinTab & "10")
 
        nfile = Dir()
    Next i
Loop
With Range("A2:U" & Range("B65000").End(xlUp).Row)
    .Value = .Value
End With
 
End Sub

07/11/2017, 18h00
Menhir
Pour que ton code fonctionne, il faudrait modifier plusieurs éléments.

D'abord, en début de ta boucle Do (entre le Do et le For), il faudrait ouvrir le fichier en question) avec un Workbooks.Open.
Avoir repéré son nom, c'est bien mais pour accéder à ses données, il ne faut pas oublier de l'ouvrir.

Ensuite, dans ton For To, il faudrait indiquer que le nombre d'onglets à scruter est celui du fichier que tu viens d'ouvrir.
Un simple Worksheets.Count donne le nombre d'onglets du fichier actif.
Remarque... si tu viens juste d'ouvrir le fichier source (voir remarque précédente), il devrait être le fichier actif. Et du coup, pas besoin d'indiquer Workbooks(nfile) dans les lignes de transfert de données.

Enfin, pour accéder à un onglet par son numéro, il suffit de mettre dans Worksheets ce numéro.
Donc pas de Worksheets("sheet" & i) mais simplement Worksheets(i).
Remarque au passage qu'il y a un "s" à Worksheets parque tu prends un indice de la collection de l'ensemble des onglets.

Mais il y a plus simple que ton For To : un For Each.
Code:

1 2 3 4 5 6 Dim MonOnglet As Worksheet For Each MonOnglet In Worksheets ... le code ... Next MonOnglet
Avec ça, la variable MonOnglet contient une référence directe à la feuille en question et tu peux y accéder simplement, par exemple pour la cellule A6, ainsi :

Code:

MonOnglet.Range("A6")

Pas besoin d'ajouter la référence Workbook à cette variable (ou alors il faut le faire au Worksheets du For Each) vu qu'il est contenu dans la référence (on ne pointe pas sur un onglet portant ce nom mais véritablement sur cet onglet unique avec toutes ses références parents et enfants).
07/11/2017, 21h48
Philippe Tulliez

Bonjour,
Une fonction "clé sur porte" proposée dans cette contribution titrée Regrouper plusieurs feuilles sur une autre. (2003-2010)

Merci Menhir pour cette réponse pertinente et très rapide :-)

Après modif suite à tes conseils, voici la macro qui fonctionne

Code:

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
Sub Récup_données()
pfile = ActiveWorkbook.Path & "\" & Range("b2") & "\" 'chemin du répertoire
nfile = Dir(pfile)
Dim i As Integer
Dim LFinTab As Integer
Dim CFinTab As Integer
Dim MonOnglet As Worksheet
 
 
Do Until nfile = ""
 Workbooks.Open pfile & nfile
    For Each MonOnglet In Worksheets
        LFinTab = Workbooks("Consolidation compilation.xlsm").Worksheets("données").Range("B" & Rows.Count).End(xlUp).Row + 1
        CFinTab = MonOnglet.Cells(9, Columns.Count).End(xlToLeft).Column
        Workbooks("Consolidation compilation.xlsm").Worksheets("données").Range("B" & LFinTab) = MonOnglet.Range("A6")
        Workbooks("Consolidation compilation.xlsm").Worksheets("données").Range("C" & LFinTab) = MonOnglet.Range("A9")
        Workbooks("Consolidation compilation.xlsm").Worksheets("données").Range("D" & LFinTab) = MonOnglet.Cells(8, CFinTab)
        Workbooks("Consolidation compilation.xlsm").Worksheets("données").Range("E" & LFinTab) = MonOnglet.Cells(9, CFinTab)
        LFinTab = LFinTab + 1
        Workbooks("Consolidation compilation.xlsm").Worksheets("données").Range("B" & LFinTab) = MonOnglet.Range("A6")
        Workbooks("Consolidation compilation.xlsm").Worksheets("données").Range("C" & LFinTab) = MonOnglet.Range("A10")
        Workbooks("Consolidation compilation.xlsm").Worksheets("données").Range("D" & LFinTab) = MonOnglet.Cells(8, CFinTab)
        Workbooks("Consolidation compilation.xlsm").Worksheets("données").Range("E" & LFinTab) = MonOnglet.Cells(10, CFinTab)
    Next MonOnglet
Workbooks(nfile).Close
nfile = Dir()
Loop
With Range("A2:U" & Range("B65000").End(xlUp).Row)
    .Value = .Value
End With
Application.ScreenUpdating = False
End Sub

Un grand merci à toi et à tous ceux qui participent au fonctionnement de ce forum

08/11/2017, 11h19
Joeytriviani

Super travail que tu proposes Philippe ! :-)
Tu as du faire bcp d'heureux avec cette macro.
Je l'ai téléchargée et mise de côté. Ça pourra surement me servir.
Pour cette fois-ci, j'ai préféré améliorer ma macro avec les conseils de Menhir (comme tu peux le voir dans le message précédent) plutôt que d'utiliser la tienne.
En effet, il faut souvent apporter des petites modifs à une macro pour pouvoir l'adapter à tel ou tel fichier. Or, quand j'ai vu le code de la tienne (code de pro), je me suis dis que je ne pourrai pas la modifier par moi-même (par exemple pour indiquer que les données des feuilles à copier ne commencent pas en A1).

Bravo pour le travail que tous les pros comme toi fournissent sur ce forum.

Bonne continuation
08/11/2017, 11h25
Joeytriviani

Citation:

Envoyé par Menhir

en début de ta boucle Do (entre le Do et le For), il faudrait ouvrir le fichier en question) avec un Workbooks.Open.
Avoir repéré son nom, c'est bien mais pour accéder à ses données, il ne faut pas oublier de l'ouvrir.

Je ne voulais justement pas passer par l'ouverture des fichiers. Quelque part dans ce forum, j'avais lu qu'il fallait mieux ne pas ouvrir les fichiers, ni faire de copier/coller, mais utiliser le code "cellule = cellule" qui permettait ainsi un gros gain de temps dans l'exécution de la macro
08/11/2017, 11h52
Menhir

Citation:

Envoyé par Joeytriviani

Après modif suite à tes conseils, voici la macro qui fonctionne

Tant mieux pour toi.

A ta place, j'aurais mis un With Workbooks("Consolidation compilation.xlsm").Worksheets("données") juste après la ligne For Each pour éviter de répéter sur plusieurs lignes cette longue séquence.
https://msdn.microsoft.com/fr-fr/VBA...with-statement

Je ne vois pas trop non plus l'intérêt de tes lignes 28 à 30 vu que ton transfert de données par "=" se fait déjà de valeur à valeur.

Citation:

Envoyé par Joeytriviani

Je ne voulais justement pas passer par l'ouverture des fichiers. Quelque part dans ce forum, j'avais lu qu'il fallait mieux ne pas ouvrir les fichiers, ni faire de copier/coller, mais utiliser le code "cellule = cellule" qui permettait ainsi un gros gain de temps dans l'exécution de la macro

Il est impossible d'accéder aux données d'un fichier (quel qu'il soit) sans l'ouvrir.
Même les méthodes qui permettent d'éviter l'ouverture par Excel font quand même une ouverture sous une autre forme.

Pour ce qui est du copier/coller, je ne sais pas dans quelle discussion tu as vus qu'il fallait les éviter mais c'est un conseil qui me semble étrange.
Etant donné le peu de cellules copiées pour chaque fichier, je doute que ça ait un impact significatif sur le temps de traitement.
C'est surtout les Select/Selection qu'il faut éviter dans ce type de manipulation.
Cela dit, la méthode que tu as utilisé est tout à fait correct si tu ne veux transmettre que des valeurs.
08/11/2017, 14h39
Joeytriviani

Citation:

Envoyé par Menhir

Même les méthodes qui permettent d'éviter l'ouverture par Excel font quand même une ouverture sous une autre forme.

Pourrais-tu mentionner une de ces méthodes d'ouverture "sous une autre forme" ? Peut être pourrais-je l'utiliser dans ce cas.

Pour les lignes 28 à 30, que tu m'indiques comme inutiles, il me semble que sans ça, ça peut coller des formules, non ?
08/11/2017, 16h23
Menhir

Citation:

Envoyé par Joeytriviani

Pourrais-tu mentionner une de ces méthodes d'ouverture "sous une autre forme" ? Peut être pourrais-je l'utiliser dans ce cas.

Tu veux essayer de faire des looping avant de maitriser le vol à l'horizontale ??? :mrgreen:

Si tu veux t'y essayer, c'est à tes risques et périls :
https://excel.developpez.com/faq/?pa...lasseursFermes

Citation:

Pour les lignes 28 à 30, que tu m'indiques comme inutiles, il me semble que sans ça, ça peut coller des formules, non ?

Enlèves-les et tu pourras constater que ce sont les valeurs qui sont transmises.

Si tu veux te rassurer, tu peux remplacer :

Code:

Workbooks("Consolidation compilation.xlsm").Worksheets("données").Range("B" & LFinTab) = MonOnglet.Range("A6")

par

Code:

Workbooks("Consolidation compilation.xlsm").Worksheets("données").Range("B" & LFinTab).Value = MonOnglet.Range("A6").Value

Mais je pense que ce n'est pas indispensable.

Citation:

Envoyé par Menhir

Tu veux essayer de faire des looping avant de maitriser le vol à l'horizontale ??? :mrgreen:

Si tu veux t'y essayer, c'est à tes risques et périls :
https://excel.developpez.com/faq/?pa...lasseursFermes

Lol.
Tu as surement raison. Cependant la première partie du lien est accessible, mais le modèle ADO a l'air plus compliqué à maitriser, je te l'accorde. Je te remercie d'ailleurs pour ton lien qui me sera peut être utile.

Après réflexion, j'ai une macro qui n'ouvre pas le fichier excel et qui pourtant permet d'accéder à des données d'un classeur fermé.

Code:

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub Récup_données()
Application.ScreenUpdating = False
pfile = ActiveWorkbook.Path & "\" & Range("b2") & "\" 'chemin du répertoire
nfile = Dir(pfile)
onglet = Range("b3")
cellule = Range("b4")
onglet2 = Range("c3")
cellule2 = Range("c4")
onglet3 = Range("d3")
cellule3 = Range("d4")
onglet4 = Range("e3")
cellule4 = Range("e4")
onglet5 = Range("f3")
cellule5 = Range("f4")
onglet6 = Range("g3")
cellule6 = Range("g4")
onglet7 = Range("h3")
cellule7 = Range("h4")
onglet8 = Range("i3")
cellule8 = Range("i4")
onglet9 = Range("j3")
cellule9 = Range("j4")
onglet10 = Range("k3")
cellule10 = Range("k4")
onglet11 = Range("l3")
cellule11 = Range("l4")
onglet12 = Range("m3")
cellule12 = Range("m4")
 
 
 
 
 
i = 10
Do Until nfile = ""
        Cells(i, 2) = "='" & pfile & "[" & nfile & "]" & onglet & "'!" & cellule
        Cells(i, 3) = "='" & pfile & "[" & nfile & "]" & onglet2 & "'!" & cellule2
        Cells(i, 4) = "='" & pfile & "[" & nfile & "]" & onglet3 & "'!" & cellule3
        Cells(i, 5) = "='" & pfile & "[" & nfile & "]" & onglet4 & "'!" & cellule4
        Cells(i, 6) = "='" & pfile & "[" & nfile & "]" & onglet5 & "'!" & cellule5
        Cells(i, 7) = "='" & pfile & "[" & nfile & "]" & onglet6 & "'!" & cellule6
        Cells(i, 8) = "='" & pfile & "[" & nfile & "]" & onglet7 & "'!" & cellule7
        Cells(i, 9) = "='" & pfile & "[" & nfile & "]" & onglet8 & "'!" & cellule8
        Cells(i, 10) = "='" & pfile & "[" & nfile & "]" & onglet9 & "'!" & cellule9
        Cells(i, 11) = "='" & pfile & "[" & nfile & "]" & onglet10 & "'!" & cellule10
        Cells(i, 12) = "='" & pfile & "[" & nfile & "]" & onglet11 & "'!" & cellule11
        Cells(i, 13) = "='" & pfile & "[" & nfile & "]" & onglet12 & "'!" & cellule12
        i = i + 1
        nfile = Dir()
Loop
With Range("A2:u" & Range("c65000").End(xlUp).Row)
    .Value = .Value
End With
End Sub

Elle utilise la première méthode décrit dans ton lien. Je ne comprends donc toujours pas qu'on ne puisse pas boucler sur des onglets d'un fichier fermé, alors qu'on est capable d'aller cherché une info si on connait son adresse précise !