Discussion :

[vincendie]

Bonjour à tous,
je reviens vers vos connaissances si vous pouviez m'aider....
en gros j'ai 5 fichiers identiques (1/poste) avec différentes feuilles dont une "1-Récap et calcul", cette dernière à la même structure dans les 5 fichiers (c'est celle dont je voudrais récupérer les infos) dans un 6 ème fichier.
voici les noms de mes fichiers:

-SIBA
-SINI
-SITU
-SIJO
-SIWA

Le fichier de destination s'appelle "consolidation" et la feuille de destination aussi ("consolidation)

Voici un code que j'ai pu trouver sur le web et que j'essaie d'adapter mais rien n'y fait...
il construit bien ma feuille avec les colonnes et entêtes mais aucune importation ne se fait

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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
Option Explicit
Sub consolider()
' Procédure permettant la consolidation de plusieurs classeurs
'
Dim wbk As Workbook
Dim wshScr As Worksheet
Dim wshDst As Worksheet
Dim celDst As Range
Dim chemin As String
Dim nomClasseur As String
Dim derLigne As Long
 
  ' On désactive le raffraichissement de l'écran
  Application.ScreenUpdating = False
  ' Définition de la feuille de destination
  Set wshDst = ThisWorkbook.Worksheets("consolidation")
  ' Etape n°1 : création des en-têtes
  'Réinitialisation du fichier de synthèse des classements
  With wshDst
    .Columns("A:CO").Clear
    .Range("A2").Value = "Nom"
    .Range("B2").Value = "Prénom"
    .Range("C2").Value = "Poste"
    .Range("D2").Value = "N°"
    .Range("E2").Value = "P/V"
    .Range("F2").Value = "Grade"
    .Range("G2").Value = "Points finaux"
    .Range("H2").Value = "ctrl YST"
    .Range("I2").Value = "Veste"
    .Range("J2").Value = "Veste taille"
    .Range("K2").Value = "Pantalon"
    .Range("L2").Value = "Pantalon taille"
    .Range("M2").Value = "T-shirt"
    .Range("N2").Value = "T-shirt taille"
    .Range("O2").Value = "Polo MC"
    .Range("P2").Value = "Polo MC taille"
    .Range("Q2").Value = "Polo ML"
    .Range("R2").Value = "Polo ML taille"
    .Range("S2").Value = "Sweat"
    .Range("T2").Value = "Sweat taille"
    .Range("U2").Value = "Pull raz du cou"
    .Range("V2").Value = "Pull raz du cou taille"
    .Range("W2").Value = "Pull col tirette"
    .Range("X2").Value = "Col tir. taille"
    .Range("Y2").Value = "Chaussette été"
    .Range("Z2").Value = "Chau été taille"
    .Range("AA2").Value = "Chaussette hiver"
    .Range("AB2").Value = "Chau hiver taille"
    .Range("AC2").Value = "Chaussure haute tige"
    .Range("AD2").Value = "Chau Ht taille"
    .Range("AE2").Value = "Chaussure sécu"
    .Range("AF2").Value = "Chau sécu taille"
    .Range("AG2").Value = "Chaussure mocassin"
    .Range("AH2").Value = "Chau mocassin taille"
    .Range("AI2").Value = "Ceinture"
    .Range("AJ2").Value = "Grade poitrine"
    .Range("AK2").Value = "Grade poitr type"
    .Range("AL2").Value = "Grades épaules"
    .Range("AM2").Value = "Grades ép. type"
    .Range("AN2").Value = "Nominette"
    .Range("AO2").Value = "Sous vêtement T-shirt"
    .Range("AP2").Value = "Ss vêt t-shirt taille"
    .Range("AQ2").Value = "Sous vêtement caleçon"
    .Range("AR2").Value = "Ss vêt caleçon taille"
    .Range("AS2").Value = "Chaussure de sport"
    .Range("AT2").Value = "Chauss sport taille"
    .Range("AU2").Value = "Short sport"
    .Range("AV2").Value = "Short sport taille"
    .Range("AW2").Value = "Vareuse sortie"
    .Range("AX2").Value = "Vareuse de sortie taille"
    .Range("AY2").Value = "Pantalon de sortie"
    .Range("AZ2").Value = "Pant sortie taille"
    .Range("BA2").Value = "Képi"
    .Range("BB2").Value = "Képi taille"
    .Range("BC2").Value = "Chemise blanche MC"
    .Range("BD2").Value = "Chem Bla MC taille"
    .Range("BE2").Value = "Chemise blanche ML"
    .Range("BF2").Value = "Chem Bla ML taille"
    .Range("BG2").Value = "Chemise bleue MC"
    .Range("BH2").Value = "Chem Ble MC taille"
    .Range("BI2").Value = "Chemise bleue ML"
    .Range("BJ2").Value = "Chem Ble ML taille"
    .Range("BK2").Value = "Chaussure de ville lacet"
    .Range("BL2").Value = "Chau ville lac taille"
    .Range("BM2").Value = "Chaussure de ville mocassin"
    .Range("BN2").Value = "Chau ville Moc taille"
    .Range("BO2").Value = "Cravatte"
    .Range("BP2").Value = "Gants noirs"
    .Range("BQ2").Value = "Gants noirs taille"
    .Range("BR2").Value = "Gants blancs"
    .Range("BS2").Value = "Gants blancs taille"
    .Range("BT2").Value = "Epaulibres"
    .Range("BU2").Value = "Casquette"
    .Range("BV2").Value = "Bonnet"
    .Range("BW2").Value = "Bretelles"
    .Range("BX2").Value = "Softshell"
    .Range("BY2").Value = "Softshell taille"
    .Range("BZ2").Value = "Couteau mulit fonction"
    .Range("CA2").Value = "Lampe torche led"
    .Range("CB2").Value = "Lampe frontale"
    .Range("CC2").Value = "Sangle Rhinoevac"
    .Range("CD2").Value = "Ciseaux ambu"
    .Range("CE2").Value = "Stétoscope"
    .Range("CF2").Value = "Solde points"
    .Range("CG2").Value = "Total tenue de service"
    .Range("CH2").Value = "Total sport"
    .Range("CI2").Value = "Total cérémonie"
    .Range("CJ2").Value = "Total accessoires"
    .Range("CK2").Value = "Total points"
    .Range("CL2").Value = "Solde calculé"
    .Range("CM2").Value = "Quota accessoires > 20%"
    .Range("CN2").Value = "Report > 10%"
    .Range("CO2").Value = "Dépassement"
        ' On définit la cellule de destination des données
    Set celDst = .Range("A3")
  End With
 
  ' Etape n° 2 : Parcourir tous les fichiers du dossier prédéfini
  chemin = ThisWorkbook.Path & "consolidation"
  ' On cherche le premier classeur dans le dossier
  nomClasseur = Dir("C:\Users\Vincent\Desktop\consolidation" & "*xlsm")
  ' On boucle pour chercher tous les classeurs
  Do While Len(nomClasseur) > 0
    If nomClasseur <> ThisWorkbook.Name Then
      Set wbk = Workbooks.Open("C:\Users\Vincent\Desktop\consolidation" & "*xlsm")  'Ouverture du Classeur
      On Error Resume Next
      Set wshScr = wbk.Worksheets("1-Récap et Calcul")          'Définis la feuille de calcul consolidation
      On Error GoTo 0
      If Not wshScr Is Nothing Then
        With wshScr
          derLigne = .Cells(.Rows.Count, "A").End(xlUp).Row  'Numéro de le derniere ligne de données
          Range("A4:CO" & derLigne).Copy celDst              'Copie de toutes les données
        End With
        ' On définit la prochaine cellule de destination des données
        Set celDst = celDst.Offset(derLigne - 2)
      End If
      wbk.Close False   ' Fermeture du classeur ouvert sans le modifier
      nomClasseur = Dir ' On passe au prochain classeur
    End If
  Loop
  MsgBox " Consolidation terminée "
  ' On ré-active le raffraichissement de l'écran '
  Application.ScreenUpdating = True
 
End Sub

Quelqu'un aurait une idée pour m'aider?
Merci à tous

[BENNASR]

bonjour
Merci de baliser ton code (mettre entre #)
je crois que pour définir une cellule ce n'est pas la peine d'écrire SET

Code :

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

Set celDst = .Range("A3")

à remplacer par

Code :

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

celDst = .Range("A3")

et il manque un point devant range si non le with n'a pas sens

Code :

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

Range("A4:CO" & derLigne).Copy celDst

à remplacer par

Code :

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

.Range("A4:CO" & derLigne).Copy celDst

[vincendie]

Bonjour, tout d'abord merci pour ton aide.
j'ai fait les changements que tu m'as conseillés mais malheureusement ça ne fonctionne toujours pas..

[vincendie]

Bonjour, tout d'abord merci pour ton aide.
j'ai fait les changements que tu m'as conseillés mais malheureusement ça ne fonctionne toujours pas..

Re-bonjour à tous, me revoilà dans la mouise...
je pense avoir uun code correct mais des messages d'erreur de mémoire insuffisante s'affichent et ferment le programme.
j'ai testé ce code sur xp au boulot et il semble fonctionner, en tentant de l'adapter a mes besoins sous Windows 10 a la maison j'ai des erreurs, une idée?

[MarcelG]

Salut,

je crois que pour définir une cellule ce n'est pas la peine d'écrire SET

Code :

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

Set celDst = .Range("A3")

à remplacer par

Code :

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

celDst = .Range("A3")

Ouh la! Bennassr.

Si une variable est affectée à un objet (Wokbook, Range..¨) alors sa définition doit impérativement débuter par Set
De plus, il est conseillé de libérer cette variable après usage.

Code :

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

Set celdest = Nothing

Vincendie,

Le plus efficace serait de reporter ton code dans la discussion.

D'emblée.
Ne manquerait-il pas un "\" dans cette déclaration?

Code :

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

ThisWorkbook.Path & "consolidation"

[MarcelG]

Salut,

Mieux vaut également neutraliser les évènements éventuels

Tu compares.

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
 
Option Explicit
 
Sub consolider()
' Procédure permettant la consolidation de plusieurs classeurs
'
Dim wbk As Workbook
Dim wshScr As Worksheet
Dim wshDst As Worksheet
Dim celDst As Range
Dim chemin As String
Dim nomClasseur As String
Dim derLigne As Long
 
  ' On désactive le raffraichissement de l'écran et les évènements Open éventuels
 With Application
    .ScreenUpdating = False
    .EnableEvents = False
  End With
 
  ' Définition de la feuille de destination
  Set wshDst = ThisWorkbook.Worksheets("consolidation")
  ' Etape n°1 : création des en-têtes
  'Réinitialisation du fichier de synthèse des classements
  ' Etape n° 2 : Parcourir tous les fichiers du dossier prédéfini
  chemin = ThisWorkbook.Path & "\Alertes"
  ' On cherche le premier classeur dans le dossier
  nomClasseur = Dir(chemin & "*xlsm")
  ' On boucle pour chercher tous les classeurs
  Do While Len(nomClasseur) > 0
    If nomClasseur <> ThisWorkbook.Name Then
      Set wbk = Workbooks.Open(ThisWorkbook.Path & "\" & nomClasseur)  'Ouverture du Classeur

avant End If

Code :

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

1
2
 
Set wbk =Npthing

en fin de procédure

Code :

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

1
2
3
4
With Application
   .EnableEvents = True
   .ScreenUpdating = True
End With

2 remarques:
1 - Il vaut mieux éviter tant que possible les

Code :

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

On Error Resume Next

Plusieurs solutions sont possibles pour tester la présence d'une feuille dans un classeur (hors balayage) dont l'une, de mémoire, de Marc-L.
2 - Dans un cas comme celui-ci, en disposant d'une fonction SommArray (concaténation de 2 tableaux), je reverserais le contenu de ce tableau final dans le classeur consolidation, en fin de procédure.

[vincendie]

Bonjour, merci pour tes réponses, j'ai tenté tant bien que mal d'intégrer tes codes mais n'étant pas très expreimenté j'ai encore des erreurs, voici ce que j'ai fait.

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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
 
Option Explicit
 
Sub consolider()
' Procédure permettant la consolidation de plusieurs classeurs
'
Dim wbk As Workbook
Dim wshScr As Worksheet
Dim wshDst As Worksheet
Dim celDst As Range
Dim chemin As String
Dim nomClasseur As String
Dim derLigne As Long
 
  ' On désactive le raffraichissement de l'écran et les évènements Open éventuels
 With Application
    .ScreenUpdating = False
    .EnableEvents = False
  End With
 
  ' Définition de la feuille de destination
  Set wshDst = ThisWorkbook.Worksheets("consolidation")
  ' Etape n°1 : création des en-têtes
     Columns("A:CO").Clear
    Range("A2").Value = "Nom"
    Range("B2").Value = "Prénom"
    Range("C2").Value = "Poste"
    Range("D2").Value = "N°"
    Range("E2").Value = "P/V"
    Range("F2").Value = "Grade"
    Range("G2").Value = "Points finaux"
    Range("H2").Value = "ctrl YST"
    Range("I2").Value = "Veste"
    Range("J2").Value = "Veste taille"
    Range("K2").Value = "Pantalon"
    Range("L2").Value = "Pantalon taille"
    Range("M2").Value = "T-shirt"
    Range("N2").Value = "T-shirt taille"
    Range("O2").Value = "Polo MC"
    Range("P2").Value = "Polo MC taille"
    Range("Q2").Value = "Polo ML"
    Range("R2").Value = "Polo ML taille"
    Range("S2").Value = "Sweat"
    Range("T2").Value = "Sweat taille"
    Range("U2").Value = "Pull raz du cou"
    Range("V2").Value = "Pull raz du cou taille"
    Range("W2").Value = "Pull col tirette"
    Range("X2").Value = "Col tir. taille"
    Range("Y2").Value = "Chaussette été"
    Range("Z2").Value = "Chau été taille"
    Range("AA2").Value = "Chaussette hiver"
    Range("AB2").Value = "Chau hiver taille"
    Range("AC2").Value = "Chaussure haute tige"
    Range("AD2").Value = "Chau Ht taille"
    Range("AE2").Value = "Chaussure sécu"
    Range("AF2").Value = "Chau sécu taille"
    Range("AG2").Value = "Chaussure mocassin"
    Range("AH2").Value = "Chau mocassin taille"
    Range("AI2").Value = "Ceinture"
    Range("AJ2").Value = "Grade poitrine"
    Range("AK2").Value = "Grade poitr type"
    Range("AL2").Value = "Grades épaules"
    Range("AM2").Value = "Grades ép. type"
    Range("AN2").Value = "Nominette"
    Range("AO2").Value = "Sous vêtement T-shirt"
    Range("AP2").Value = "Ss vêt t-shirt taille"
    Range("AQ2").Value = "Sous vêtement caleçon"
    Range("AR2").Value = "Ss vêt caleçon taille"
    Range("AS2").Value = "Chaussure de sport"
    Range("AT2").Value = "Chauss sport taille"
    Range("AU2").Value = "Short sport"
    Range("AV2").Value = "Short sport taille"
    Range("AW2").Value = "Vareuse sortie"
    Range("AX2").Value = "Vareuse de sortie taille"
    Range("AY2").Value = "Pantalon de sortie"
    Range("AZ2").Value = "Pant sortie taille"
    Range("BA2").Value = "Képi"
    Range("BB2").Value = "Képi taille"
    Range("BC2").Value = "Chemise blanche MC"
    Range("BD2").Value = "Chem Bla MC taille"
    Range("BE2").Value = "Chemise blanche ML"
    Range("BF2").Value = "Chem Bla ML taille"
    Range("BG2").Value = "Chemise bleue MC"
    Range("BH2").Value = "Chem Ble MC taille"
    Range("BI2").Value = "Chemise bleue ML"
    Range("BJ2").Value = "Chem Ble ML taille"
    Range("BK2").Value = "Chaussure de ville lacet"
    Range("BL2").Value = "Chau ville lac taille"
    Range("BM2").Value = "Chaussure de ville mocassin"
    Range("BN2").Value = "Chau ville Moc taille"
    Range("BO2").Value = "Cravatte"
    Range("BP2").Value = "Gants noirs"
    Range("BQ2").Value = "Gants noirs taille"
    Range("BR2").Value = "Gants blancs"
    Range("BS2").Value = "Gants blancs taille"
    Range("BT2").Value = "Epaulibres"
    Range("BU2").Value = "Casquette"
    Range("BV2").Value = "Bonnet"
    Range("BW2").Value = "Bretelles"
    Range("BX2").Value = "Softshell"
    Range("BY2").Value = "Softshell taille"
    Range("BZ2").Value = "Couteau mulit fonction"
    Range("CA2").Value = "Lampe torche led"
    Range("CB2").Value = "Lampe frontale"
    Range("CC2").Value = "Sangle Rhinoevac"
    Range("CD2").Value = "Ciseaux ambu"
    Range("CE2").Value = "Stétoscope"
    Range("CF2").Value = "Solde points"
    Range("CG2").Value = "Total tenue de service"
    Range("CH2").Value = "Total sport"
    Range("CI2").Value = "Total cérémonie"
    Range("CJ2").Value = "Total accessoires"
    Range("CK2").Value = "Total points"
    Range("CL2").Value = "Solde calculé"
    Range("CM2").Value = "Quota accessoires > 20%"
    Range("CN2").Value = "Report > 10%"
    Range("CO2").Value = "Dépassement"
  'Réinitialisation du fichier de synthèse des classements
  ' Etape n° 2 : Parcourir tous les fichiers du dossier prédéfini
  chemin = ThisWorkbook.Path & "\Alertes"
  ' On cherche le premier classeur dans le dossier
  nomClasseur = Dir(chemin & "*xlsm")
  ' On boucle pour chercher tous les classeurs
  Do While Len(nomClasseur) > 0
    If nomClasseur <> ThisWorkbook.Name Then
      Set wbk = Workbooks.Open(ThisWorkbook.Path & "\" & nomClasseur)  'Ouverture du Classeur
   'Réinitialisation du fichier de synthèse des classements
  With wshDst
 
        ' On définit la cellule de destination des données
    Set celDst = .Range("A3")
  End With
 
  ' Etape n° 2 : Parcourir tous les fichiers du dossier prédéfini
  chemin = ThisWorkbook.Path & "consolidation"
  ' On cherche le premier classeur dans le dossier
  nomClasseur = Dir("C:\Users\Vincent\Desktop\consolidation" & "*xlsm")
  ' On boucle pour chercher tous les classeurs
  Do While Len(nomClasseur) > 0
    If nomClasseur <> ThisWorkbook.Name Then
      Set wbk = Workbooks.Open("C:\Users\Vincent\Desktop\consolidation" & "*xlsm")  'Ouverture du Classeur
      On Error Resume Next
      Set wshScr = wbk.Worksheets("1-Récap et Calcul")          'Définis la feuille de calcul consolidation
      On Error GoTo 0
      If Not wshScr Is Nothing Then
        With wshScr
          derLigne = .Cells(.Rows.Count, "A").End(xlUp).Row  'Numéro de le derniere ligne de données
          Range("A4:CO" & derLigne).Copy celDst              'Copie de toutes les données
        End With
        ' On définit la prochaine cellule de destination des données
        Set celDst = celDst.Offset(derLigne - 2)
 
       End If
      wbk.Close False   ' Fermeture du classeur ouvert sans le modifier
      nomClasseur = Dir ' On passe au prochain classeur
        End If
  Loop
  MsgBox " Consolidation terminée "
  ' On ré-active le raffraichissement de l'écran '
  With Application
   .EnableEvents = True
   .ScreenUpdating = True
End With
End Sub

Qu'en penses tu?

[MarcelG]

Bonjour Vincent, Bonjour au Forum,

Reporte le message d'erreur, et précise la ligne qui en est la source.
Celle-ci est surlignée en jaune (généralement) dans l'éditeur VBE.

Un conseil également.
Intègre l'alimentation des entêtes de colonnes dans une autre procédure que tu peux appeler depuis la procédure principale par l'instruction Call.
Ton développement gagnera en lisibilité.

[vincendie]

Bonjour Vincent, Bonjour au Forum,

Reporte le message d'erreur, et précise la ligne qui en est la source.
Celle-ci est surlignée en jaune (généralement) dans l'éditeur VBE.

Un conseil également.
Intègre l'alimentation des entêtes de colonnes dans une autre procédure que tu peux appeler depuis la procédure principale par l'instruction Call.
Ton développement gagnera en lisibilité.

là j'ai tout qui part en sucette! plus rien ne fonctionne

[MarcelG]

Salut,

là j'ai tout qui part en sucette! plus rien ne fonctionne

Quoi au juste?
Effectue l'exécution pas à pas et reporte l'erreur comme je l'ai indiqué dans mon post précédent.
As-tu séparé l'alimentation des entêtes sur une autre procédure, comme je te l'ai suggéré?

Si la problématique n'est pas due à cette procédure secondaire, alors le contrôle sera plus aisé en shuntant celle-ci (mise en zone de texte)

'Call alim_entêtes

Pour avancer, il faudrait reporter plus d'éléments.