Correction boucle Do While Loop pour consolider plusieurs fichiers excel dans un fichier du même répertoire

**ladylez** · 08/06/2021, 16h44

Bonjour à tous,

Je suis nouvelle sur le forum et novice en VBA...ça fait beaucoup

, alors d'avance 1000 excuses pour les énormités que vous allez voir.

Objectif : dans un dossier, j'ai plusieurs fichiers excel nommés de la même façon (rootWbName = Reception_*.xlsm), seule la date change. Je cherche à ouvrir ces fichiers les uns après les autres, mettre en forme et copier les valeurs de l'onglet 1 pour les coller dans l'onglet 1 d'un fichier de synthèse (targetWb = Synthese_*.xlsx).

Problématique : Le premier passage dans la boucle fonctionne, en revanche je n'arrive pas à accéder au second fichier rootWbName. Il me faudrait une correction si possible.

Code : Ci-dessous le code que j'ai réussi à produire en fouillant sur le net. Il se trouve dans le module d'un autre fichier excel.

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
 
Sub MacroReception()
 
'****************************************************************************************************************************************************************************
' Macro créée par  le 03/03/21
' Permet de mettre à jour les fichiers qui se trouvent dans le même répertoire que la présente macro
' Insert la date fichier en colonne P
' Supprime les données non essentielles de l'onglet FLUX TOTAL
' Agrège les données de chaque classeur quotidien dans un classeur de synthèse qui se trouve dans le même répertoire
'****************************************************************************************************************************************************************************
 
'*********************************************************************
' Etape 1 : Déclaration des variables
'*********************************************************************
Dim targetWb As Workbook 'déclare la variable targetWb (Classeur Cible = Synthse_*.xlsx)
Dim targetWs As Worksheet 'déclare la variable targetWs actif (Onglet Cible=Feuil1)
Dim rootPath As String 'déclare la variable rootPath (Chemin d'Accès aux classeurs quotidiens et au classeur de synthèse)
Dim rootWbName As String 'déclare la variable rootWbName (nom des fichiers sources = Reception_*.xlsm)
Dim rootWb As Workbook 'déclare la variable rootWb (Classeur Source = classeur quotidien)
Dim rootWs As Worksheet 'déclare la variable rootWs (onglet source = FLUX TOTAL)
 
Dim targetFile As String 'déclare la variable targetFile (Fichier Cible=classeur de synthèse)
Dim NomFichier, SplitNomFichier, DateFichier, DateFormatee, fichieDeplace, FichierOriginal As String
Dim i As Integer, DerniereLigne As Integer
 
'*********************************************************************
' Etape 2 : Définir le chemin, les fichiers et onglets
'*********************************************************************
rootPath = "P:\Mes documents\06-Qlik_BI\02-Reception\RECEPTION 2021\" 'définit le chemin d'accès rootPath
rootWbName = Dir(rootPath & "\Reception_*.xlsm") 'indique le répertoire et le type de fichiers à rechercher : Reception_* du dossier ayant rootPath comme chemin d'accès (extension à adapter !)
targetFile = Dir(rootPath & "\Synthese_*.xlsx") 'définit le classeur destination targetFile
 
 
Set targetWb = Application.Workbooks.Open(rootPath & targetFile) 'définit le classeur ouvert targetWb (en l'ouvrant)
Set targetWs = targetWb.Sheets("synthese")  'définit l'onglet actif targetWs
 
 
'*********************************************************************
' Etape 3 : Parcourir tous les fichiers du dossier courant "Reception"
'*********************************************************************
'Application.ScreenUpdating = False 'Désactiver le rafraîchissement de l'écran avant la macro
Do While rootWbName <> "" ' on boucle pour chercher tous les fichiers rootWbName
 'Do While Len(rootWbName) > 0
 
        ' Afficher le nom du fichier en cours d'execution
        'MsgBox ActiveWorkbook.Name
 
        '**********************************************************
        ' Etape 4 : ouvrir/activer le classeur source quotiden
        '**********************************************************
        Workbooks.Open (rootPath & rootWbName)
        Set rootWb = ActiveWorkbook
        Set rootWs = rootWb.Sheets("FLUX TOTAL")
 
        '**********************************************************
        ' Etape 5 : Mise en forme du classeur quotidien
        '**********************************************************
        'copier/coller les valeurs de l'onglet
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
        ' supprimer la 1ere ligne
        Rows("1:1").Select
        Selection.Delete Shift:=xlUp
 
        ' boucle pour supprimmer les lignes vides
        lastRow = Range("A" & Rows.Count).End(xlUp).Row
        For i = lastRow To 1 Step -1
            If Worksheets("FLUX TOTAL").Cells(i, 1).Value = "" Then
            Worksheets("FLUX TOTAL").Rows(i).Delete
            End If
        Next i
 
        'Nommer la colonne P "date"
        Range("P1").Value = "Date"
 
        ' Recupérer la date qui se trouve dans le nom du fichier et la placer en P2
        NomFichier = ActiveWorkbook.Name
        SplitNomFichier = Split(NomFichier, "_")(1)
        DateFichier = Left(SplitNomFichier, 10)
        'DateFormatee = Replace(DateFichier, ".", "/")
        [P2] = DateFichier
        Selection.NumberFormat = "dd/mm/yy;@"
 
        ' Coller la date sur chaque ligne du tableau
        Range("P2").Select
        Selection.Copy
        Range(Selection, Selection.End(xlDown)).Select
        ActiveSheet.Paste
 
        'Supprimer le contenu de la colonne Q
        Columns("Q:Q").Select
        Selection.ClearContents
 
        'Selectionner la plage de données hors en-tête et copier
        Range("A1").Select
        lastCol = ActiveSheet.Range("a1").End(xlToRight).Column
        lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, lastCol).End(xlUp).Row
        ActiveSheet.Range("a2", ActiveSheet.Cells(lastRow, lastCol)).Copy
 
        '*********************************************************************
        ' Etape 6 : Consolider dans le fichier de synthèse
        '*********************************************************************
        With targetWs
            Windows(targetFile).Activate
            Workbooks(targetFile).Activate
            Set targetWb = ActiveWorkbook 'définit le classeur de synthèse cible targetWb comme actif
 
            'Sélection de la cellule vide au bas d’une colonne de données contiguës
            ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
 
            'Copier la plage de données
            Debug.Print ActiveWorkbook.Name
            Debug.Print ActiveSheet.Name
            ActiveSheet.Paste
 
            'Désactiver les messages d'alerte à la fermeture
            Application.DisplayAlerts = False
        End With
 
        'Ferme le classeur quotidien ouvert en enregistrant les changements
        rootWb.Close SaveChanges:=False
 
    rootWbName = Dir()   'classeur quotidien suivant du dossier ayant rootPath comme chemin d'accès
 
Loop 'boucle
 
'Ferme le classeur de synthèse ouvert en enregistrant les changements
targetWb.Close SaveChanges:=True
'Application.ScreenUpdating = True
 
 
MsgBox "La macro a fini de bosser"
 
 
End Sub

J'ai tester la boucle et de cette manière, cela fonctionne

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
 
Sub TestBoucleFichiers()
    Dim chemin As String, Fichier As String
 
    'Définit le répertoire contenant les fichiers
    chemin = "P:\Mes documents\06-Qlik_BI\02-Reception\RECEPTION 2021\"
 
    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(chemin & "Reception_*.xlsm")
    'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers :
    'Fichier = Dir(Chemin & "*.*")
 
    Do While Fichier <> ""
        'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
        ' Debug.Print chemin & Fichier
        MsgBox Fichier
        Fichier = Dir()
    Loop
End Sub

Donc je suppose que c'est en passant des fichiers sources à la synthèse que mon code ne va pas. Mais où???
Si quelqu'un a un peu de temps je l'en remercie.

**Nicolas MENDEZ** · 08/06/2021, 23h02

Hello,

J'ai une option sans code... C'est Power Query qui est capable d'empiler tous les fichiers contenus dans un même dossier.

Nom : Animation.gif
Affichages : 378
Taille : 178,2 Ko

Nom : Animation.gif
Affichages : 378
Taille : 178,2 Ko

**ChristianBosch** · 09/06/2021, 11h31

Merci Power BI de nous simplifier autant la vie

**ladylez** · 09/06/2021, 12h33

Envoyé par Nicolas MENDEZ

Hello,

J'ai une option sans code... C'est Power Query qui est capable d'empiler tous les fichiers contenus dans un même dossier.

Nom : Animation.gif
Affichages : 378
Taille : 178,2 Ko

Merci beaucoup. J'ai fait ça ce matin en un rien de temps!!!

**Nicolas MENDEZ** · 09/06/2021, 12h49

Cool !

L'essayer c'est l'adopter....

Correction boucle Do While Loop pour consolider plusieurs fichiers excel dans un fichier du même répertoire [XL-2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager