Macro avec ouverture de fichiers contenant des macros

**eric4459** · 18/02/2015, 15h16

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

**PMO2017** · 18/02/2015, 17h08

Bonjour,

Cernez l'instruction "Workbooks.Open WkPath & Fname 'ouvre le fichier" comme suit

Code :

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

1
2
3
Application.EnableEvents = False    '///ajout
Workbooks.Open WkPath & Fname 'ouvre le fichier
Application.EnableEvents = True     '///ajout

**eric4459** · 18/02/2015, 18h05

Bonjour,
Merci pour l'info mais cette astuce ne semble pas diminuer le temps de traitement...
Eric

**Marc-L** · 18/02/2015, 18h29

Bonjour,

l'utilisation de boucles est souvent la cause de ralentissement pour copier / coller des données par exemple
alors qu'il y a les puissants filtres ou encore l'affectation directe d'une formule de calculs à une plage de cellules …

Mieux vaut utiliser la méthode Copy directement en précisant son paramètre Destination au lieu de Copy puis Paste.

En dehors de désactiver l'affichage de l'écran et les évènements, si la feuille traitée est dotée de formules dans ses cellules
ou de mise en forme conditionnelle, mieux vaut aussi penser à désactiver le mode de calcul automatique !

__________________________________________________________________________________________________
Tous unis, tous Charlie

**eric4459** · 19/02/2015, 09h26

Envoyé par Marc-L

Mieux vaut utiliser la méthode Copy directement en précisant son paramètre Destination au lieu de Copy puis Paste.

Bonjour Marc,
Pourrais-tu m'en dire un peu plus sur cette méthode?
J'ai récemment utilisé ceci pour copier une feuille

Code :

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

wkB.Sheets("Feuil1").Copy before:=wkA.Sheets(1)

Comment appliquer cette méthode à une plage de cellule?

Autre piste peut-etre : ouvrir les fichiers en lecture seule ? Mais là je me demande si je pourrais copier mes cellules

Merci pour ton aide
Eric

**Marc-L** · 19/02/2015, 12h37

Là tu copies l'intégralité d'une feuille dans une nouvelle.

Mon exemple concernait la méthode Range.Copy et son paramètre Destination,
la nouvelle feuille devant déjà être créée …

Avec ou sans condition, le plus rapide est souvent le filtre avancé.

Aucun souci pour lire des données d'un fichier en lecture seule.

**eric4459** · 19/02/2015, 13h04

Marc

L'exemple que je donnais concernait effectivement la copie de la feuille entière.

Ce que je souhaiterai c'est un exemple de code pour un range.

Sinon quel est le code pour ouvrir un fichier en lecture seule ?

Eric

**Marc-L** · 19/02/2015, 13h16

Et l'exemple de l'aide ?

Pour le fichier, voir l'aide de la méthode Workbooks.Open et son paramètre ReadOnly,
livré sur un plateau par le Générateur de macros …

**eric4459** · 19/02/2015, 16h44

Marc
J'ai essayé

Code :

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

Open (WkPath & Fname,ReadOnly)as workbook

mais j'ai toujours le message

Erreur de Compilation Attendu : )

Code :

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

Workbooks.Open (WkPath & Fname,ReadOnly)

message

Erreur de Compilation Attendu : =

Quelle est la bonne syntaxe?

Eric

**Marc-L** · 19/02/2015, 19h36

La bonne syntaxe est celle livrée sur un plateau par le Générateur de macros :

ReadOnly:=True ou directement True après la virgule et non pas ReadOnly !

**eric4459** · 20/02/2015, 10h34

Marc,
J'ai bien tenté de passer par l'éditeur de macro, mais il ne m'a rien livré sur un plateau même après avoir spécifié que le fichier que je souhaitais ouvrir devrait l’être en lecture seule.
L'aide m'a fourni des infos, j'ai tenté de les adapter mais la solution ne m'a été, là non plus, livrée sur un plateau.

En tout cas voilà ce que j'ai fini par trouver, et pas sur un plateau...

Code :

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

Workbooks.Open Filename:=WkPath & Fname, ReadOnly:=True

Mais, car il y a un mais, cela ne résout pas mon problème initial qui est la lenteur du traitement à cause de l'ouverture de fichiers avec des macros...

Il y a peut-être une solution que je vais essayer:

enregistrer dans un premier temps le classeur sans macro
ouvrir le classeur
copier les données
fermer le classeur en l'enregistrant comme un fichier supportant les macros

Eric

Macro avec ouverture de fichiers contenant des macros

Macros et VBA Excel

Discussions similaires

Partager

Partager