Macro avec ouverture de fichiers contenant des macros
Bonjour à tous,
J'ai créé une macro dont l'objectif est de collecter des informations dans plusieurs fichiers Excel, ceci afin de faire une synthèse générale.
La macro crée fonctionne correctement mais je trouve que le temps de traitement est un peu long :
- depuis mon fichier j'ouvre un classeur, copie les données qui m’intéressent ( cellules J6:AX10 de l'onglet Data), ferme le classeur et colle les données dans mon classeur de synthèse dans un onglet spécifique.
- j'ouvre à nouveau le même classeur, copie d'autres données (cellules J12:AX16 de l'onglet Data), ferme le classeur et colle les données sur une seconde feuille de mon classeur synthèse.
Cette opération est répétée autant de fois que j'ai de classeur à traiter.
Lors de tests en pas à pas, je me suis aperçu que lors de l'ouverture de mes fichiers, l'éditeur de macro ouvrait tous les modules de chacun des fichiers, en effet tous les fichiers que j'ai à traiter contiennent plusieurs modules de code et autres UserForm.
Je penses donc que le temps de traitement se trouve augmenté à cause de cela.
Voici mon code
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
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
| Option Explicit
Sub Project_Progress()
Dim WkPath As String
Dim File As String
Dim Fname As String
Dim WBK1 As Workbook
Dim WBKDest As Workbook
Dim Wk As Worksheet
Dim Baseline As Worksheet
Dim Actual As Worksheet
Dim Curv As Worksheet
Dim WKS As Range
Dim Bsl As Range
Dim Act As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim NumbCell As Integer
Set Wk = ThisWorkbook.Sheets("Main")
Set Baseline = ThisWorkbook.Sheets("Baseline")
Set Actual = ThisWorkbook.Sheets("Actual")
Set Curv = ThisWorkbook.Sheets("Curve")
Set WKS = Wk.Range("A1")
Set Bsl = Baseline.Range("A1")
Set Act = Actual.Range("A1")
WKS = WKS.Offset(0)
Bsl = Bsl.Offset(0)
Act = Act.Offset(0)
WkPath = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
File = Dir(WkPath)
Wk.Range("A1:" & Range("A1").SpecialCells(xlCellTypeLastCell).Address).ClearContents ' On efface toute les données
'La 1ère boucle ci_dessous va rechercher tous les fichiers du répertoire
'et coller les résultats dans la colonne C
Do While File <> ""
i = i + 1
Wk.Range("C" & i) = File
File = Dir
Loop
i = 0
'La deuxième boucle recherche les fichiers dont le nom contient PACKAGE et les colle en colonne A
Do While WKS.Offset(i, 2) <> ""
If WKS.Offset(i, 2) Like "*PACKAGE*" Then
WKS.Offset(j, 0) = WKS.Offset(i, 2)
End If
i = i + 1
If WKS.Offset(j, 0) = 0 Then
j = j
Else
j = j + 1
End If
Loop
'Ici on va effacer les données de la colonne C
Wk.Range("C1:" & Range("C1").SpecialCells(xlCellTypeLastCell).Address).ClearContents
Application.DisplayAlerts = False
With Sheets("Main")
NumbCell = .Cells(.Rows.Count, 1).End(xlUp).Row - 1 ' On compte le nombre de fichiers présents en colonne A
End With
j = 0
Set WBKDest = ThisWorkbook
For i = 0 To NumbCell
Fname = WKS.Offset(i, 0) 'Donne le nom du fichier à ouvrir
' Copie des données de la baseline
Workbooks.Open WkPath & Fname 'ouvre le fichier
Set WBK1 = ActiveWorkbook
Dim Data As Worksheet 'déclaration des varibles du fichier ouvert
Dim Dest As Range
Set Data = WBK1.Sheets("Data")
Set Dest = Data.Range("J6")
'Dest = Dest.Offset(0)
Range(Dest, Dest.End(xlToRight).End(xlDown)).Copy ' Copie des données
WBK1.Close 'Fermeture du classeur
Set WBKDest = ActiveWorkbook
Bsl.Offset(j, 0).PasteSpecial 'Colle les données dans le classeur origine
'Copie des Données Actual
Workbooks.Open WkPath & Fname
Set WBK1 = ActiveWorkbook 'ouvre le fichier
Dim Data2 As Worksheet 'déclaration des varibles du fichier ouvert
Dim Dest2 As Range
Set Data2 = WBK1.Sheets("Data")
Set Dest2 = Data2.Range("J12")
Dest2 = Dest2.Offset(0)
Range(Dest2.Offset(0, 0), Dest2.Offset(0, 0).End(xlToRight).End(xlDown)).Copy ' Copie des données
WBK1.Close
Set WBKDest = ActiveWorkbook
Act.Offset(j, 0).PasteSpecial 'Colle les données dans le classeur origine
j = j + 6
k = k + 1
Next i
Application.ScreenUpdating = True
End Sub |
Existe-t-il une astuce en Vba pour désactiver les macros contenues dans les fichiers à ouvrir puis les réactiver à la fin ou tout autre astuce pour simplifier la manipulation.
Merci pour votre aide et vos conseils
Eric
