Bug sur code compilation fichiers

**JulienG__** · 09/08/2012, 12h16

Bonjour à tous,

Après lecture de différents sujets, j'ai essayé de créer un code (grande première pour moi) afin de compiler différents fichiers xls mais qui comporte de nombreux bugs et imperfections.
Je me remets donc à vous pour pouvoir les résoudre.

J'ai un nombre non défini de fichiers xls dans un dossier "Fiches à compiler" dont les intitulés exacts ne sont pas connus.
Pour chacun des fichiers, je souhaite copier les cellules B3 à B34 de l'onglet "Fiche Annuaire AICM" pour les coller dans un fichier "Synthèse" (idéalement sous forme de lignes les unes en dessous des autres).

Vous trouverez en pièce jointe un fichier .rar qui comporte le fichier de synthèse comportant la macro ainsi que des fichiers test à compiler.

Merci d'avance à celui / celle qui pourra m'aider, j'avoue avoir passer pas mal de temps dessus ne pas m'en sortir !
N'hésitez pas à me demander plus de précisions,

Cordialement,
Julien

----
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
Sub Recup()
 
    Dim Fichier As String
    Dim Chemin As String
    Dim I As Integer
 
    'adapter le chemin où se trouvent les classeurs
    Chemin = "C:\Users\jug65138\Desktop\Julien Guerle\Autre\Perso\AICM\Compilation automatique\Bug sur code compilation fichiers\Fiches à compiler\"
 
    'récupère tous les classeurs Excel .xls (pas les autres, donc à adapter)
    Fichier = Dir(Chemin & "*.xls")
 
    'évite les entêtes
    I = 1
 
    'boucle sur tous les classeurs afin de récupérer les valeurs dans la feuille 1 ("Fiche Annuaire AICM")
    'adapter le nom des feuille
    Do While Fichier <> ""
 
        I = I + 1
        'récupère les valeurs par formules
 
        Range("A" & I).Value = Fichier
        Range("A" & I).Offset(0, 1).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B3"
        Range("A" & I).Offset(0, 2).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B4"
        Range("A" & I).Offset(0, 3).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B5"
        Range("A" & I).Offset(0, 4).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B6"
        Range("A" & I).Offset(0, 5).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B7"
        Range("A" & I).Offset(0, 6).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B8"
        Range("A" & I).Offset(0, 7).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B9"
        Range("A" & I).Offset(0, 8).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B10"
        Range("A" & I).Offset(0, 9).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B11"
        Range("A" & I).Offset(0, 10).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B12"
        Range("A" & I).Offset(0, 11).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B13"
        Range("A" & I).Offset(0, 12).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B14"
        Range("A" & I).Offset(0, 13).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B15"
        Range("A" & I).Offset(0, 14).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B16"
        Range("A" & I).Offset(0, 15).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B17"
        Range("A" & I).Offset(0, 16).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B18"
        Range("A" & I).Offset(0, 17).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B19"
        Range("A" & I).Offset(0, 18).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B20"
        Range("A" & I).Offset(0, 19).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B21"
        Range("A" & I).Offset(0, 20).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B22"
        Range("A" & I).Offset(0, 21).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B23"
        Range("A" & I).Offset(0, 22).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B24"
        Range("A" & I).Offset(0, 23).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B25"
        Range("A" & I).Offset(0, 24).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B26"
        Range("A" & I).Offset(0, 25).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B27"
        Range("A" & I).Offset(0, 26).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B28"
        Range("A" & I).Offset(0, 27).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B29"
        Range("A" & I).Offset(0, 28).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B30"
        Range("A" & I).Offset(0, 29).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B31"
        Range("A" & I).Offset(0, 30).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B32"
        Range("A" & I).Offset(0, 31).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B33"
        Range("A" & I).Offset(0, 32).Formula = "='" & Chemin & "[" & Fichier & "]Fiche Annuaire AICM'!B34"
 
 
        'et ne garde que les valeurs
        Range("A" & I).Offset(0, 1).Value = Range("A" & I).Offset(0, 1).Value
        Range("A" & I).Offset(0, 2).Value = Range("A" & I).Offset(0, 2).Value
        Range("A" & I).Offset(0, 3).Value = Range("A" & I).Offset(0, 3).Value
        Range("A" & I).Offset(0, 4).Value = Range("A" & I).Offset(0, 4).Value
        Range("A" & I).Offset(0, 5).Value = Range("A" & I).Offset(0, 5).Value
        Range("A" & I).Offset(0, 6).Value = Range("A" & I).Offset(0, 6).Value
        Range("A" & I).Offset(0, 7).Value = Range("A" & I).Offset(0, 7).Value
        Range("A" & I).Offset(0, 8).Value = Range("A" & I).Offset(0, 8).Value
        Range("A" & I).Offset(0, 9).Value = Range("A" & I).Offset(0, 9).Value
        Range("A" & I).Offset(0, 10).Value = Range("A" & I).Offset(0, 10).Value
        Range("A" & I).Offset(0, 11).Value = Range("A" & I).Offset(0, 11).Value
        Range("A" & I).Offset(0, 12).Value = Range("A" & I).Offset(0, 12).Value
        Range("A" & I).Offset(0, 13).Value = Range("A" & I).Offset(0, 13).Value
        Range("A" & I).Offset(0, 14).Value = Range("A" & I).Offset(0, 14).Value
        Range("A" & I).Offset(0, 15).Value = Range("A" & I).Offset(0, 15).Value
        Range("A" & I).Offset(0, 16).Value = Range("A" & I).Offset(0, 16).Value
        Range("A" & I).Offset(0, 17).Value = Range("A" & I).Offset(0, 17).Value
        Range("A" & I).Offset(0, 18).Value = Range("A" & I).Offset(0, 18).Value
        Range("A" & I).Offset(0, 19).Value = Range("A" & I).Offset(0, 19).Value
        Range("A" & I).Offset(0, 20).Value = Range("A" & I).Offset(0, 20).Value
        Range("A" & I).Offset(0, 21).Value = Range("A" & I).Offset(0, 21).Value
        Range("A" & I).Offset(0, 22).Value = Range("A" & I).Offset(0, 22).Value
        Range("A" & I).Offset(0, 23).Value = Range("A" & I).Offset(0, 23).Value
        Range("A" & I).Offset(0, 24).Value = Range("A" & I).Offset(0, 24).Value
        Range("A" & I).Offset(0, 25).Value = Range("A" & I).Offset(0, 25).Value
        Range("A" & I).Offset(0, 26).Value = Range("A" & I).Offset(0, 26).Value
        Range("A" & I).Offset(0, 27).Value = Range("A" & I).Offset(0, 27).Value
        Range("A" & I).Offset(0, 28).Value = Range("A" & I).Offset(0, 28).Value
        Range("A" & I).Offset(0, 29).Value = Range("A" & I).Offset(0, 29).Value
        Range("A" & I).Offset(0, 30).Value = Range("A" & I).Offset(0, 30).Value
        Range("A" & I).Offset(0, 31).Value = Range("A" & I).Offset(0, 31).Value
        Range("A" & I).Offset(0, 32).Value = Range("A" & I).Offset(0, 32).Value
 
 
 
 
        'fichier suivant
        Fichier = Dir
 
    Loop
 
End Sub

**michoutri** · 23/08/2012, 12h06

SAlut

J'ai clarifier ton code et je pense que les buggs ont disparu.
Le problème était dans le transfert des données
J'ai préféré faire afficher chaque fiche pour travailler avec et les fermer une fois le transfère des données réalisé.

En espérant que cela fonctionne

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
 
Sub Recup()
 
    Dim Fichier As String
    Dim Chemin As String
    Dim I As Integer, j As Integer
 
    'adapter le chemin où se trouvent les classeurs
    Chemin = "C:\Users\jug65138\Desktop\Julien Guerle\Autre\Perso\AICM\Compilation automatique\Bug sur code compilation fichiers\Fiches à compiler\"
 
    'récupère tous les classeurs Excel .xls (pas les autres, donc à adapter)
    Fichier = Dir(Chemin & "*.xls")
 
    'évite les entêtes
    I = 1
 
    'on supprime les données présentent dans le tableau de synthèse
    Rows("2:" & Range("A2").End(xlDown).Row).ClearContents
 
    'boucle sur tous les classeurs afin de récupérer les valeurs dans la feuille 1 ("Fiche Annuaire AICM")
    'adapter le nom des feuille
    Do While Fichier <> ""
        Application.Workbooks.Open Chemin & Fichier
        Workbooks("Synthèse.xlsm").Activate
        I = I + 1
 
        Workbooks("Synthèse.xlsm").Sheets(1).Range("A" & I).Value = Fichier
 
        For j = 1 To 32
            'récupère les valeurs
            Workbooks("Synthèse.xlsm").Sheets(1).Range("A" & I).Offset(0, j).Value = _
            Workbooks(Fichier).Sheets(1).Range("B" & j + 2).Value
        Next j
 
        Workbooks(Fichier).Close
        'fichier suivant
        Fichier = Dir
 
    Loop
 
End Sub

Ciao

Bug sur code compilation fichiers

Macros et VBA Excel

Discussions similaires

Partager

Partager