Discussion :

[Alqualonde]

Bonjour,

J'ai créé une macro dans un fichier dit de gestion, permettant d'aller récupérer des informations dans des fichiers remplis par des utilisateurs, qui sont formatés de telle sorte à ce que les informations à récupérer soient bien toujours aux mêmes endroits (même nom d'onglet, mêmes cellules).
Pour chaque utilisateur qui aura déposé son fichier dans le répertoire commun, je récupère (manuellement) le nom que je reporte dans mon fichier de gestion (ligne 2, colonnes 11, 13, 15...).
La macro permet ensuite d'ouvrir chacun des fichiers correspondant à ce nom, puis d'aller copier les données saisies par l'utilisateur, et de les coller dans le fichier de gestion. Comme certains utilisateurs peuvent ne remplir qu'une partie des champs et renvoyer d'autres données ultérieurement, je fais un test sur la présence d'information dans mon fichier de gestion : je n'écrase donc pas une information qui aurait été saisie auparavant.

Tout cela fonctionne bien, mais j'ai quand même l'impression que mon code est lourd (même si le temps d'exécution avec 2 fichiers test est assez raisonnable, je me pose la question quand j'en aurai 50 ou plus...). Y'a-t-il moyen de l'optimiser ? Est-ce que ce sont les ouvertures de fichiers qui sont longues ?

Par avance, merci pour vos suggestions.

Voici le code en question :

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
Sub BoucleFichiers()
    Dim CheminP As String, NomFichierGestion As String
    Dim NomP As String
    Dim i As Integer
    Dim FichierGestion As Workbook
    Dim OngletGestionRes As Worksheet
 
    Dim NomFichierP As String
    Dim FichierPro As Workbook
    Dim OngletP As Worksheet
 
    Application.ScreenUpdating = False
 
    'Définit le répertoire contenant les fichiers
    CheminP = "C:\MonRep\"
 
    NomFichierGestion = ThisWorkbook.Name
 
    Set FichierGestion = ThisWorkbook
    Set OngletGestionRes = FichierGestion.Worksheets("Rés")
 
    OngletGestionRes.Unprotect
 
    'Boucle sur tous les fichiers xls du répertoire.
    NomFichierP = Dir(CheminP & "*.xls*")
    Do While Len(NomFichierP) > 0
        i = 11
        Do While OngletGestionRes.Cells(2, i).Value <> ""
            NomP = OngletGestionRes.Cells(2, i).Value
            If NomFichierP Like "*" & NomP & "*" Then
                Workbooks.Open Filename:=CheminP & NomFichierP
                Set FichierPro = ActiveWorkbook
                Set OngletP = FichierPro.Worksheets("Donnees a recup")
                For lig = 3 To 38
                    If OngletGestionRes.Cells(lig, i) = "" Then
                        OngletGestionRes.Cells(lig, i) = OngletP.Cells(lig + 3, 7)
                        OngletGestionRes.Cells(lig, i + 1) = OngletP.Cells(lig + 3, 8)
                    End If
                Next
                ' Récupération des 2 autres données intéressantes 
                OngletGestionRes.Cells(55, i) = OngletP.Cells(2, 9)
                OngletGestionRes.Cells(56, i) = OngletP.Cells(3, 9)
                FichierPro.Close
            End If
            i = i + 2
        Loop
 
        NomFichierP = Dir()
    Loop
 
    OngletGestionRes.Protect
 
    Application.ScreenUpdating = True
End Sub

[thebenoit59]

Bonjour Alqualonde.

Je ne suis pas certain que le code soit fonctionnel, surtout au niveau du tableau, et la correspondance entre les différentes lignes.

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
Sub BoucleFichiers()
    Dim CheminP As String, NomFichierGestion As String
    Dim NomP As String
    Dim i As Integer
    Dim FichierGestion As Workbook
    Dim OngletGestionRes As Worksheet
 
    Dim NomFichierP As String
    Dim FichierPro As Workbook
    Dim OngletP As Worksheet
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
 
    'Définit le répertoire contenant les fichiers
    CheminP = "C:\MonRep\"
 
    NomFichierGestion = ThisWorkbook.Name
 
    Set FichierGestion = ThisWorkbook
    Set OngletGestionRes = FichierGestion.Worksheets("Rés")
 
    OngletGestionRes.Unprotect
 
    'Boucle sur tous les fichiers xls du répertoire.
    NomFichierP = Dir(CheminP & "*.xls*")
    Do While Len(NomFichierP) > 0
        i = 11
        Do While OngletGestionRes.Cells(2, i).Value <> ""
            NomP = OngletGestionRes.Cells(2, i).Value
                If NomFichierP Like "*" & NomP & "*" Then
                    Set FichierPro = Workbooks.Open(CheminP & NomFichierP)
                    Set OngletP = FichierPro.Worksheets("Donnees a recup")
                    t = OngletP.Range("g6:g41") 'On met les données sous forme de tableau
                    FichierPro.Close False
                    With OngletGestionRes
                        .Cells(55, i).Resize(2).Value = OngletP.Cells(2, 9).Resize(2).Value
                        For lig = 3 To 38
                            If .Cells(lig, i).Value = "" Then .Cells(lig, i).Resize(, 2).Value = Application.Index(t, lig - 2, Array(1, 2))
                        Next
                    End With
                End If
            i = i + 2
        'Loop
        NomFichierP = Dir()
    Loop
 
    OngletGestionRes.Protect
 
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

[Alqualonde]

Bonjour thebenoit59, et merci pour ta réponse !

Hormis le dernier loop qui était commenté à tort et un petit end if qui manquait, ça avait l'air OK, mais j'avais une erreur d'exécution '-2147221080 (800401a8)' Erreur Automation, située, d'après le mode débogage, sur la première ligne du With :

Code :

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

 .Cells(55, i).Resize(2).Value = OngletP.Cells(2, 9).Resize(2).Value

En cherchant des erreurs similaires sur le Net, ça avait l'air lié à un problème de .close. J'ai déplacé le FichierPro.close après le bloc With et ça marche !!!

Au passage, j'ai remplacé le

Code :

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

Range("g6:g41")

par

Code :

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

Range("g6:h41")

pour bien tout copier.


Merci beaucoup !! Ca tourne effectivement beaucoup plus vite... quasi instantané !

[thebenoit59]

Effectivement, maintenant que tu soulignes les problèmes que tu as rencontré, ça me paraît logique.
Content que ça fonctionne alors.