Macro Conso plusieurs fichiers

**vasipolo** · 12/02/2014, 11h59

Bonjour à tous,

Premier post pour moi sur ce forum que j'ai beaucoup consulté par le passé.
Aujourd'hui j'ai un outil de conso qui me permet de consolider les données de plusieurs fiches projets, une centaine. J'avais demandé que l'outil consolide les données d'un onglet de synthèse présent sur chaque fiche reporting. Il y avait donc consolidation de 2 lignes par fichier.
Je me rends compte à présent que j'ai besoin de plus de détail, si ce n'est de tout le détail.

Donc au lieu de consolider les lignes 5 et 6 de l'onglet Closing, il me faudrait les lignes 5 à 500 d'un autre onglet. Je ne pense donc pas que le changement soit radical mais je ne sais pas faire. Je dirais donc que les lignes à changer sont celles en rouge.
Un peu plus bas vous trouverez la macro dans son intégralité.

A votre dispo pour toute qustion et un grand merci à ceux qui prendront le temps de me lire

A++

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
Private Sub read_file(file As String, directory As String)

    lien = directory + "\" + file
    
    Set oXLApp = Application.Workbooks.Open(lien)
    Set ws_closing = oXLApp.Sheets("Closing")
    
    ensemble = oXLApp.Sheets("Timesheet").Range("D12").Value
    
    Call copy_data(row_start_conso, 5, lien, ensemble) 'CHANGE
    Call copy_data(row_start_conso + 1, 6, lien, ensemble)  'HSTD
    
    row_start_conso = row_start_conso + 2    
    oXLApp.Close
    Set oXLApp = Nothing

LA MACRO ENTIERE

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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
'Worksheet
Dim ws_conso As Worksheet
Dim ws_closing As Worksheet
Dim ws_liste_ts As Worksheet
 
'Row
Dim billing_month As String
 
Dim row_start_conso As Integer
Dim col_start_conso As Integer
Dim row_end_conso As Integer
 
 
Sub consolidate()
 
    Dim path As String
 
    'MsgBox de sélection du répertoire
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    fd.Title = "Veuillez sélectionner le répertoire dans lequel se trouve les TS OPER à consolider :"
    fd.Show
    If fd.SelectedItems.Count > 0 Then
        path = fd.SelectedItems(1)
    End If
    Set fd = Nothing
 
    If path <> "" Then
 
        Dim directory_files As String
 
        Application.Calculation = xlManual
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.AskToUpdateLinks = False
 
        Set ws_liste_ts = ActiveWorkbook.Sheets("Liste_TS")
        ws_liste_ts.Range("A2:E1000").Clear
 
        'on écrit dans l'onglet Liste_TS la liste de tous les sous-répertoires et de toutes les TS du répertoire sélectionné ci-dessus
        Call liste_ts(path, 2)
 
        Call init_data_conso
        Call clear_sheet_conso
 
        'On parcourt la liste des TS de l'onglet Liste_TS
        i = 2
        While ws_liste_ts.Cells(i, 2) <> ""
            If Mid(ws_liste_ts.Cells(i, 2), 1, 3) = "MRT" Then
                Call read_file(ws_liste_ts.Cells(i, 2), ws_liste_ts.Cells(i, 3))
            End If
            i = i + 1
        Wend
 
        group_empty_rows (7)
 
        Application.DisplayAlerts = True
        Application.Calculation = xlAutomatic
        Application.ScreenUpdating = True
        Application.AskToUpdateLinks = True
 
    End If
 
 
End Sub
 
Private Sub read_file(file As String, directory As String)
 
    lien = directory + "\" + file
 
    Set oXLApp = Application.Workbooks.Open(lien)
    Set ws_closing = oXLApp.Sheets("Closing")
 
    ensemble = oXLApp.Sheets("Timesheet").Range("D12").Value
 
    Call copy_data(row_start_conso, 5, lien, ensemble) 'CHANGE
    Call copy_data(row_start_conso + 1, 6, lien, ensemble)  'HSTD
 
    row_start_conso = row_start_conso + 2
 
    oXLApp.Close
    Set oXLApp = Nothing
 
 
End Sub
 
Private Sub init_data_conso()
 
    Set ws_conso = ThisWorkbook.ActiveSheet
 
    billing_month = ws_conso.Range("B4").Value
    row_start_conso = 7
    col_start_conso = 1
    row_end_conso = ws_conso.Range("A7:C1000").Find("Total", LookIn:=xlValues).row - 1
 
 
End Sub
 
 
 
Private Sub clear_sheet_conso()
 
    ws_conso.Range("A" & row_start_conso & ":AA" & row_end_conso).Value = ""
 
End Sub
 
 
 
Private Sub copy_data(row_conso, row_closing, lien, ensemble)
 
 
    ActiveSheet.Hyperlinks.Add Anchor:=ws_conso.Cells(row_conso, col_start_conso), Address:=lien, TextToDisplay:="TS"
    ws_conso.Cells(row_conso, col_start_conso + 1).Value2 = ensemble
    ws_conso.Cells(row_conso, col_start_conso + 2).Value2 = ws_closing.Cells(row_closing, 3).Value2
 
    ws_conso.Cells(row_conso, col_start_conso + 3).Value2 = ws_closing.Cells(row_closing, 6).Value2
    ws_conso.Cells(row_conso, col_start_conso + 4).Value2 = ws_closing.Cells(row_closing, 27).Value2
 
    ws_conso.Cells(row_conso, col_start_conso + 6).Value2 = ws_closing.Cells(row_closing, 28).Value2
 
    ws_conso.Cells(row_conso, col_start_conso + 8).Value2 = ws_closing.Cells(row_closing, 16).Value2
    ws_conso.Cells(row_conso, col_start_conso + 9).Value2 = ws_closing.Cells(row_closing, 7).Value2
    ws_conso.Cells(row_conso, col_start_conso + 10).Value2 = ws_closing.Cells(row_closing, 8).Value2
    ws_conso.Cells(row_conso, col_start_conso + 11).Value2 = ws_closing.Cells(row_closing, 9).Value2
    ws_conso.Cells(row_conso, col_start_conso + 12).Value2 = ws_closing.Cells(row_closing, 10).Value2
    ws_conso.Cells(row_conso, col_start_conso + 13).Value2 = ws_closing.Cells(row_closing, 11).Value2
    ws_conso.Cells(row_conso, col_start_conso + 14).Value2 = ws_closing.Cells(row_closing, 12).Value2
    ws_conso.Cells(row_conso, col_start_conso + 15).Value2 = ws_closing.Cells(row_closing, 13).Value2
    ws_conso.Cells(row_conso, col_start_conso + 16).Value2 = ws_closing.Cells(row_closing, 14).Value2
    ws_conso.Cells(row_conso, col_start_conso + 17).Value2 = ws_closing.Cells(row_closing, 15).Value2
 
    ws_conso.Cells(row_conso, col_start_conso + 19).Value2 = ws_closing.Cells(row_closing, 29).Value2
 
    ws_conso.Cells(row_conso, col_start_conso + 21).Value2 = ws_closing.Cells(row_closing, 18).Value2
    ws_conso.Cells(row_conso, col_start_conso + 22).Value2 = ws_closing.Cells(row_closing, 19).Value2
 
    ws_conso.Cells(row_conso, col_start_conso + 24).Value2 = ws_closing.Cells(row_closing, 30).Value2
    ws_conso.Cells(row_conso, col_start_conso + 25).Value2 = ws_closing.Cells(row_closing, 4).Value2
    ws_conso.Cells(row_conso, col_start_conso + 26).Value2 = ws_closing.Cells(row_closing, 21).Value2
    ws_conso.Cells(row_conso, col_start_conso + 27).Value2 = ws_closing.Cells(row_closing, 22).Value2
    ws_conso.Cells(row_conso, col_start_conso + 28).Value2 = ws_closing.Cells(row_closing, 23).Value2
 
 
End Sub
 
 
 
 
Private Sub liste_ts(path As String, r As Integer)
 
    Dim FSO As Scripting.FileSystemObject
    Dim DossierSource As Scripting.Folder, SousDossier As Scripting.Folder
    Dim Fichier As Scripting.file
 
    Set ws = ActiveWorkbook.Sheets("Liste_TS")
    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(path)
 
    For Each Fichier In DossierSource.Files
        ws.Cells(r, 2) = Fichier.Name
        ws.Cells(r, 3) = Fichier.ParentFolder
        r = r + 1
    Next Fichier
 
    For Each SousDossier In DossierSource.SubFolders
            liste_ts SousDossier.path, r
    Next SousDossier
 
    Set SousDossier = Nothing
    Set Fichier = Nothing
    Set DossierSource = Nothing
    Set FSO = Nothing
 
End Sub
 
 
Public Sub group_empty_rows(start_row)
 
    ' on sélectionne toutes les lignes de la zone pour enlever les groupements
    ws_conso.Rows(start_row & ":" & row_end_conso).Select
    Selection.Rows.Ungroup
    Selection.Rows.Hidden = False
 
    i = row_start_conso
    While ws_conso.Cells(i, 3) <> ""
        i = i + 1
    Wend
 
    ws_conso.Rows(i + 2 & ":" & row_end_conso).Select
    Selection.Rows.Group
 
    'on ferme le groupement
    ActiveSheet.Outline.ShowLevels RowLevels:=1
    ActiveSheet.Range("C4").Select
 
End Sub

**vasipolo** · 12/02/2014, 16h22

Aïe, j'ai peur d'en avoir trop dit :-), ça fait peut-être peur à certains

Pour faire plus court cette ligne de code permet de copier la ligne 5, j'aimerais la même qui copie les lignes 5 à 500.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Call copy_data(row_start_conso, 5, lien, ensemble)

Suis une bille en VBA donc je ne sais pas faire, mais je trouverais étonnant que ça soit vraiment compliqué à faire.

Macro Conso plusieurs fichiers

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager