Bonjour,

Je suis débutant sur VBA, je viens de créer un programme car je voudrais compiler dans un fichier des informations de plusieurs fichiers.
Mon fichier qui compile les informations va ouvrir les fichiers excel qui sont dans le même répertoire et recopier les valeurs si le fichier commence par Wave.

La macro ouvre les fichiers et va enregistrer dans des variables des cellules ensuite elle les copie dans mon fichier recap.

Le code fonctionne mais la macro est trop longue, elle mouline pendant beaucoup de temps.
De plus je souhaite copier davantage de cellule mais j'ai peur que le programme ne soit encore plus long.

Y-a-t-il un moyen pour améliorer le code? Est-on obliger d'ouvrir le fichier pour collecter des données? Y-a-til un autre moyen que stocker chaque cellule dans des variables indépendantes?

Merci pour votre aide.

Voici mon premier code, soyez indulgent :

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
 
Sub ListingFichiers()
 
Dim Rep As String, Fichier As String
Dim i As Integer
Dim file_ongoing As String
Dim path_ongoing As String
Dim nom As String
Dim numero As String
Dim montantHT As Double
Dim montantTTC As Double
Dim datef As Date
 
 
 
Application.ScreenUpdating = False  'utiliser pour am?liorer la vitesse de la macro
Application.Calculation = xlCalculationManual 'utiliser pour am?liorer la vitesse de la macro
 
'suppression de l'ancien historique
Sheets("Feuil2").Select
Range("A1").CurrentRegion.Select
Selection.ClearContents
 
'cr?ation de l'historique
Sheets("Feuil1").Select
Range("A1").CurrentRegion.Select
Selection.Copy
Sheets("Feuil2").Select
Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
'suppression de l'ancien export
Sheets("Feuil1").Select
Range("A1").CurrentRegion.Select
Selection.ClearContents
 
 
'définition des titres du tabeau
Range("A1") = "Nom du fichier"
Range("B1") = "Type de document"
Range("C1") = "Num?ro"
Range("D1") = "Date de cr?ation"
Range("E1") = "Montant HT (?)"
Range("F1") = "Montant TTC (?)"
Range("G1") = "Commentaire 1"
Range("H1") = "Commentaire 2"
 
file_ongoing = ThisWorkbook.Name 'on r?cup?re le nom du fichier r?cap
path_ongoing = ThisWorkbook.Path 'on r?cup?re le chemin sur le r?seau o? se trouve le fichier
 
Rep = path_ongoing & "\" 'avec la fonction ThisWorkbook.path il manque un \ donc on l'ajoute
 
Fichier = Dir(Rep)
 
Do While Fichier <> "" 'boucle dans le r?pertoire
    If Fichier <> file_ongoing And Left(Fichier, 4) Like "Wave" Then
        i = i + 1
          Sheets("Feuil1").Range("A" & i + 1) = Fichier
            Workbooks.Open(Rep & Fichier).Activate  'ouverture d'un fichier comprenant le nom "wave"
            ActiveSheet.Unprotect "wave"            'mot de passe du fichier verrouill?
              nom = Sheets("Feuil1").Range("nom")   ' r?cup?ration de pluiseurs info dans diff?rentes variables
              numero = Sheets("Feuil1").Range("numero")
              datef = Sheets("Feuil1").Range("date")
              montantHT = Sheets("Feuil1").Range("montantHT")
              montantTTC = Sheets("Feuil1").Range("montantTTC")
            ActiveSheet.Protect "wave"
            ActiveWorkbook.Close SaveChanges:=False  'fermeture du fichier
 
            Sheets("Feuil1").Range("B" & i + 1) = nom   'copie des variables
            Sheets("Feuil1").Range("C" & i + 1) = numero
            Sheets("Feuil1").Range("D" & i + 1) = datef
            Sheets("Feuil1").Range("E" & i + 1) = montantHT
            Sheets("Feuil1").Range("F" & i + 1) = montantTTC
    End If
    Fichier = Dir  'fichier suivant
Loop
 
 
    Range("A1:H" & i + 1).Select 'mise en forme du tableau
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$H$" & i + 1), , xlYes).Name = _
        "Tableau4"
    ActiveSheet.ListObjects("Tableau4").TableStyle = "TableStyleLight2"
    Columns("A:F").EntireColumn.AutoFit
 
 
Range("K1") = i
 
End Sub