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 : 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
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