Erreur "La méthode Range de l'objet global a échoué"

**Antony1812** · 20/03/2013, 12h07

Bonjour,

Je suis un novice qui cherche à développer un outil Excel afin de transférer les données issues d'un programme de calcul thermique vers des tableaux recensant les résultats.

Malgré toute ma bonne volonté je n'arrive pas à corriger cette erreur.
Je rencontre aussi un souci au niveau de la ligne 193 de ce programme que j'explique à l'aide d'un petit commentaire.

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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
Sub Récupération_données()
 
' Récupération_données Macro
 
Dim Cell As Variant
Dim cpt As Integer
Dim Somme_Vitrage As Single
Dim ligne As Integer
Dim lignea As Integer
Dim ligneb As Integer
Dim lignec As Integer
Dim ligned As Integer
Dim lignee As Integer
Dim lignef As Integer
Dim ligneg As Integer
Dim ligneh As Integer
Dim lignei As Integer
 
'Délimitation de la zone d'activité
 
    cpt = 2
    Sheets("Perrenoud").Select
    Range("A1:G800").Select
 
For Each Cell In Selection
        If Cell.Value = "CATALOGUE DES PAROIS DE L'ETAT PROJET" Then
        ligne = Cell.Row
        End If
Next Cell
 
'Début des boucles permettant de définir le nom des surfaces, leur coefficient U ainsi que leur garde-fou
 
    Range("A1:G" & ligne).Select
 
For Each Cell In Selection
 
        If Cell.Value = "Mur extérieur (A1)" Then
        Sheets("Initial").Range("A" & cpt) = "Mur extérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Mur intérieur (A1)" Then
        Sheets("Initial").Range("A" & cpt) = "Mur intérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plancher intérieur (A4)" Then
        Sheets("Initial").Range("A" & cpt) = "Plancher intérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
'Problème dans le fichier Perrenoud, il s'agit d'un  plancher intérieur sur VS mais test pour voir si cela fonctionne
' bien penser à modifier pour après
 
        If Cell.Value = "Plancher extérieur (A4)" And InStr(1, Cell.Offset(0, 1).Value, "VS", 0) Then
        Sheets("Initial").Range("A" & cpt) = "Plancher sur vide sanitaire"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.4
        cpt = cpt + 1
        ElseIf Cell.Value = "Plancher extérieur (A4)" And Not InStr(1, Cell.Offset(0, 1).Value, "VS", 0) Then
        Sheets("Initial").Range("A" & cpt) = "Plancher sur extérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.36
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plancher sur terre-plein (A4)" Then
        Sheets("Initial").Range("A" & cpt) = "Plancher sur terre-plein"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.41
        cpt = cpt + 1
        End If
 
        If InStr(1, Cell.Value, "Plafond extérieur (A3)", 0) Then
        Sheets("Initial").Range("A" & cpt) = "Toiture"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.34
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond intérieur RT2000 (A3)" Then
        Sheets("Initial").Range("A" & cpt) = "Plafond intérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.28
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond ext. légers (A2)" Then
        Sheets("Initial").Range("A" & cpt) = "Toiture extérieure légere"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond intérieur (A2)" Then
        Sheets("Initial").Range("A" & cpt) = "Plafond intérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
Next Cell
 
'On fait la même chose pour le vitrage en commençant par délimiter la zone d'activité
 
For Each Cell In Selection
 
       If Cell.Value = "ETAT INITIAL : CALCUL du COEFFICIENT UBAT" Then
       lignea = Cell.Row
       End If
 
       If Cell.Value = "RECAPITULATIF des SURFACES des BAIES" Then
       ligneb = Cell.Row
       End If
 
Next Cell
 
    Range("A" & lignea, "F" & ligneb).Select
 
'Par précaution au cas où il y ait plusieurs types de vitrages, j'en ai mis 5 mais on peut augmenter en copiant la ligne
 
For Each Cell In Selection
 
       If Cell.Value = "Vitrage 1" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage"
       End If
 
       If Cell.Value = "Vitrage 2" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage2"
       End If
 
       If Cell.Value = "Vitrage 3" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage3"
       End If
 
       If Cell.Value = "Vitrage 4" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage4"
       End If
 
       If Cell.Value = "Vitrage 5" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage5"
       End If
 
Next Cell
 
'On copie maintenant la valeur de la surface considérée par rapport au coefficient u
 
cpt = 2
 
For Each Cell In Selection
       If Cell.Value = (Sheets("Initial").Range("D" & cpt).Value) Then
       Sheets("Initial").Range("C" & cpt) = Cell.Offset(0, 2).Value
       cpt = cpt + 1
       End If
Next Cell
 
'Je comprends pas pourquoi la valeur de la dernière surface ne s'inscrit pas dans le tableau, j'ai fait varier l'ensemble des
'paramètres mais rien ne change
 
 
For Each Cell In Selection 'Je paramètre une zone d'action
 
       If Cell.Value = "CATALOGUE DES VITRAGES DE L'ETAT INITIAL" Then
       lignec = Cell.Row
       End If
       If Cell.Value = "ETAT INITIAL : CALCUL du COEFFICIENT UBAT" Then
       ligned = Cell.Row
       End If
 
Next Cell
 
    Range("A" & lignec, "B" & ligned).Select
 
For Each Cell In Selection
       If Cell.Value = "Désignation" Then
       Sheets("Initial").Range("B" & cpt) = Cell.Offset(2, 0).Value
       cpt = cpt + 1
       End If
Next Cell
 
'L'erreur range m'empêche de savoir si le code est bon, ma zone d'action n'arrive pas à se définir
 
'Macro qui concerne l'état projet
 
 cpt = 2
    Sheets("Perrenoud").Select
    Range("A1:G800").Select
 
For Each Cell In Selection
        If Cell.Value = "CATALOGUE DES PAROIS DE L'ETAT PROJET" Then
        lignee = Cell.Row
        End If
Next Cell
 
'Début des boucles permettant de définir le nom des surfaces, leur coefficient U ainsi que leur garde-fou
 
    Range("A" & lignee, G800).Select
 
For Each Cell In Selection
 
        If Cell.Value = "Mur extérieur (A1)" Then
        Sheets("Projet").Range("A" & cpt) = "Mur extérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Mur intérieur (A1)" Then
        Sheets("Projet").Range("A" & cpt) = "Mur intérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plancher intérieur (A4)" Then
        Sheets("Projet").Range("A" & cpt) = "Plancher intérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
'Problème dans le fichier Perrenoud, il s'agit d'un  plancher intérieur sur VS mais test pour voir si cela fonctionne
' bien penser à modifier pour après
 
        If Cell.Value = "Plancher extérieur (A4)" And InStr(1, Cell.Offset(0, 1).Value, "VS", 0) Then
        Sheets("Projet").Range("A" & cpt) = "Plancher sur vide sanitaire"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.4
        cpt = cpt + 1
        ElseIf Cell.Value = "Plancher extérieur (A4)" And Not InStr(1, Cell.Offset(0, 1).Value, "VS", 0) Then
        Sheets("Projet").Range("A" & cpt) = "Plancher sur extérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.36
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plancher sur terre-plein (A4)" Then
        Sheets("Projet").Range("A" & cpt) = "Plancher sur terre-plein"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.41
        cpt = cpt + 1
        End If
 
        If InStr(1, Cell.Value, "Plafond extérieur (A3)", 0) Then
        Sheets("Projet").Range("A" & cpt) = "Toiture"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.34
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond intérieur RT2000 (A3)" Then
        Sheets("Projet").Range("A" & cpt) = "Plafond intérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.28
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond ext. légers (A2)" Then
        Sheets("Projet").Range("A" & cpt) = "Toiture extérieure légere"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond intérieur (A2)" Then
        Sheets("Projet").Range("A" & cpt) = "Plafond intérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
Next Cell
 
'On fait la même chose pour le vitrage en commençant par délimiter la zone d'activité
 
For Each Cell In Selection
 
       If Cell.Value = "ETAT PROJET : CALCUL du COEFFICIENT UBAT" Then
       lignef = Cell.Row
       End If
 
       If Cell.Value = "RECAPITULATIF des SURFACES des BAIES" Then
       ligneg = Cell.Row
       End If
 
Next Cell
 
Range("A" & lignef, "F" & ligneg).Select
 
'Par précaution au cas où il y ait plusieurs types de vitrages, j'en ai mis 5 mais on peut augmenter en copiant la ligne
 
For Each Cell In Selection
 
       If Cell.Value = "Vitrage 1" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage"
       End If
 
       If Cell.Value = "Vitrage 2" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage2"
       End If
 
       If Cell.Value = "Vitrage 3" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage3"
       End If
 
       If Cell.Value = "Vitrage 4" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage4"
       End If
 
       If Cell.Value = "Vitrage 5" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage5"
       End If
 
Next Cell
 
'On copie maintenant la valeur de la surface considérée par rapport au coefficient u
 
Range("A" & lignef, "F" & ligneg).Select
cpt = 2
 
For Each Cell In Selection
 
       If Cell.Value = (Sheets("Projet").Range("D" & cpt).Value) Then
       Sheets("Projet").Range("C" & cpt) = Cell.Offset(0, 2).Value
       cpt = cpt + 1
       End If
 
Next Cell
 
'Je comprends pas pourquoi la valeur de la dernière surface ne s'inscrit pas dans le tableau, j'ai fait varier l'ensemble des
'paramètres mais rien ne change
 
For Each Cell In Selection 'Je paramètre une zone d'action
 
       If Cell.Value = "CATALOGUE DES VITRAGES DE L'ETAT PROJET" Then
       ligneh = Cell.Row
       End If
       If Cell.Value = "ETAT PROJET : CALCUL du COEFFICIENT UBAT" Then
       lignei = Cell.Row
       End If
 
Next Cell
 
Range("A" & ligneh, "B" & lignei).Select
 
For Each Cell In Selection
       If Cell.Value = "Désignation" Then
       Sheets("Projet").Range("B" & cpt) = Cell.Offset(2, 0).Value
       cpt = cpt + 1
       End If
Next Cell
 
End Sub

Merci d'avance pour toutes vos réponses !!!

Visual Basiquement vôtre .

Antony

**NEC14** · 20/03/2013, 15h34

Bonjour,

De quelle erreur parles-tu ? Peux-tu être plus explicite ? Cela sera plus clair pour t'apporter une aide.
Merci par avance

**Antony1812** · 20/03/2013, 15h54

Bonjour NEC14,

En fait, lorsque je teste ma macro, il s'affiche une erreur 1004 "La méthode RANGE de l'objet global a échoué"

J'ai un peu avancé par rapport à ce matin mais c'est toujours ce type d'erreur qui me pénalise. J'ai pu la stopper en affinant mes zones de recherches à une seule colonne mais même en faisant cela ici je n'arrive pas à l'enlever.

Le but de cette macro est de pouvoir extraire les données issues d'un logiciel de calcul thermique vers deux tableaux récapitulatifs, un avant travaux et l'autre après travaux.

Le language est donc identique pour les deux, seules les cellules et la feuille de destination changent. Si tu as besoin de précision n'hésites pas

Voici où j'en suis actuellement :

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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
Sub Récupération_données()
 
' Récupération_données Macro
 
Dim Cell As Variant
Dim cpt As Integer
Dim Somme_Vitrage As Single
Dim ligne As Integer
Dim lignea As Integer
Dim ligneb As Integer
Dim lignec As Integer
Dim ligned As Integer
Dim lignee As Integer
Dim lignef As Integer
Dim ligneg As Integer
Dim ligneh As Integer
Dim lignei As Integer
 
'Délimitation de la zone d'activité
 
    cpt = 2
    Sheets("Perrenoud").Select
    Range("A1:A800").Select
 
For Each Cell In Selection
        If Cell.Value = "CATALOGUE DES PAROIS DE L'ETAT PROJET" Then
        ligne = Cell.Row
        End If
Next Cell
 
'Début des boucles permettant de définir le nom des surfaces, leur coefficient U ainsi que leur garde-fou
    Sheets("Perrenoud").Select
    Range("B1:B" & ligne).Select
 
For Each Cell In Selection
 
        If Cell.Value = "Mur extérieur (A1)" Then
        Sheets("Initial").Range("A" & cpt) = "Mur extérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Mur intérieur (A1)" Then
        Sheets("Initial").Range("A" & cpt) = "Mur intérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plancher intérieur (A4)" Then
        Sheets("Initial").Range("A" & cpt) = "Plancher intérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
'Problème dans le fichier Perrenoud, il s'agit d'un  plancher intérieur sur VS mais test pour voir si cela fonctionne
' bien penser à modifier pour après
 
        If Cell.Value = "Plancher extérieur (A4)" And InStr(1, Cell.Offset(0, 1).Value, "VS", 0) Then
        Sheets("Initial").Range("A" & cpt) = "Plancher sur vide sanitaire"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.4
        cpt = cpt + 1
        ElseIf Cell.Value = "Plancher extérieur (A4)" And Not InStr(1, Cell.Offset(0, 1).Value, "VS", 0) Then
        Sheets("Initial").Range("A" & cpt) = "Plancher sur extérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.36
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plancher sur terre-plein (A4)" Then
        Sheets("Initial").Range("A" & cpt) = "Plancher sur terre-plein"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.41
        cpt = cpt + 1
        End If
 
        If InStr(1, Cell.Value, "Plafond extérieur (A3)", 0) Then
        Sheets("Initial").Range("A" & cpt) = "Toiture"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.34
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond intérieur RT2000 (A3)" Then
        Sheets("Initial").Range("A" & cpt) = "Plafond intérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.28
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond ext. légers (A2)" Then
        Sheets("Initial").Range("A" & cpt) = "Toiture extérieure légere"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond intérieur (A2)" Then
        Sheets("Initial").Range("A" & cpt) = "Plafond intérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
Next Cell
 
'On fait la même chose pour le vitrage en commençant par délimiter la zone d'activité
 
    Sheets("Perrenoud").Select
    Range("A1:A" & ligne).Select
 
For Each Cell In Selection
 
       If Cell.Value = "ETAT INITIAL : CALCUL du COEFFICIENT UBAT" Then
       lignea = Cell.Row
       End If
 
       If Cell.Value = "RECAPITULATIF des SURFACES des BAIES" Then
       ligneb = Cell.Row
       End If
 
Next Cell
 
    Sheets("Perrenoud").Select
    Range("A" & lignea, "A" & ligneb).Select
 
'Par précaution au cas où il y ait plusieurs types de vitrages, j'en ai mis 5 mais on peut augmenter en copiant la ligne
 
For Each Cell In Selection
 
       If Cell.Value = "Vitrage 1" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage"
       End If
 
       If Cell.Value = "Vitrage 2" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage2"
       End If
 
       If Cell.Value = "Vitrage 3" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage3"
       End If
 
       If Cell.Value = "Vitrage 4" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage4"
       End If
 
       If Cell.Value = "Vitrage 5" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage5"
       End If
 
Next Cell
 
'On copie maintenant la valeur de la surface considérée par rapport au coefficient u
 
cpt = 2
    Sheets("Perrenoud").Select
    Range("D" & lignea, "D" & ligneb).Select
 
For Each Cell In Selection
       If Cell.Value = (Sheets("Initial").Range("D" & cpt).Value) Then
       Sheets("Initial").Range("C" & cpt) = Cell.Offset(0, 2).Value
       cpt = cpt + 1
       End If
Next Cell
 
'Je comprends pas pourquoi la valeur de la dernière surface ne s'inscrit pas dans le tableau, j'ai fait varier l'ensemble des
'paramètres mais rien ne change
 
    Sheets("Perrenoud").Select
    Range("A1:A" & ligne).Select
 
For Each Cell In Selection 'Je paramètre une zone d'action
 
       If Cell.Value = "CATALOGUE DES VITRAGES DE L'ETAT INITIAL" Then
       lignec = Cell.Row
       End If
       If Cell.Value = "ETAT INITIAL : CALCUL du COEFFICIENT UBAT" Then
       ligned = Cell.Row
       End If
 
Next Cell
 
    Sheets("Perrenoud").Select
    Range("B" & lignec, "B" & ligned).Select
 
For Each Cell In Selection
       If Cell.Value = "Désignation" Then
       Sheets("Initial").Range("B" & cpt) = Cell.Offset(2, 0).Value
       cpt = cpt + 1
       End If
Next Cell
 
'L'erreur range m'empêche de savoir si le code est bon, ma zone d'action n'arrive pas à se définir
 
'Macro qui concerne l'état projet
 
 cpt = 2
    Sheets("Perrenoud").Select
    Range("A1:A800").Select
 
For Each Cell In Selection
        If Cell.Value = "CATALOGUE DES PAROIS DE L'ETAT PROJET" Then
        lignee = Cell.Row
        End If
Next Cell
 
'Début des boucles permettant de définir le nom des surfaces, leur coefficient U ainsi que leur garde-fou
 
    Sheets("Perrenoud").Select
    Range("A" & lignee).End(xlDown).Select
 
 
For Each Cell In Selection
 
        If Cell.Value = "Mur extérieur (A1)" Then
        Sheets("Projet").Range("A" & cpt) = "Mur extérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Mur intérieur (A1)" Then
        Sheets("Projet").Range("A" & cpt) = "Mur intérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plancher intérieur (A4)" Then
        Sheets("Projet").Range("A" & cpt) = "Plancher intérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
'Problème dans le fichier Perrenoud, il s'agit d'un  plancher intérieur sur VS mais test pour voir si cela fonctionne
' bien penser à modifier pour après
 
        If Cell.Value = "Plancher extérieur (A4)" And InStr(1, Cell.Offset(0, 1).Value, "VS", 0) Then
        Sheets("Projet").Range("A" & cpt) = "Plancher sur vide sanitaire"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.4
        cpt = cpt + 1
        ElseIf Cell.Value = "Plancher extérieur (A4)" And Not InStr(1, Cell.Offset(0, 1).Value, "VS", 0) Then
        Sheets("Projet").Range("A" & cpt) = "Plancher sur extérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.36
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plancher sur terre-plein (A4)" Then
        Sheets("Projet").Range("A" & cpt) = "Plancher sur terre-plein"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.41
        cpt = cpt + 1
        End If
 
        If InStr(1, Cell.Value, "Plafond extérieur (A3)", 0) Then
        Sheets("Projet").Range("A" & cpt) = "Toiture"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.34
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond intérieur RT2000 (A3)" Then
        Sheets("Projet").Range("A" & cpt) = "Plafond intérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.28
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond ext. légers (A2)" Then
        Sheets("Projet").Range("A" & cpt) = "Toiture extérieure légere"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond intérieur (A2)" Then
        Sheets("Projet").Range("A" & cpt) = "Plafond intérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
Next Cell
 
'On fait la même chose pour le vitrage en commençant par délimiter la zone d'activité
 
    Sheets("Perrenoud").Select
    Range("A1").End(xlDown).Select
 
For Each Cell In Selection
 
       If Cell.Value = "ETAT PROJET : CALCUL du COEFFICIENT UBAT" Then
       lignef = Cell.Row
       End If
 
       If Cell.Value = "ETAT PRESSENTI" Then
       ligneg = Cell.Row
       End If
 
Next Cell
 
    Sheets("Perrenoud").Select
    Range("A" & lignef, "A" & ligneg).Select
 
'Par précaution au cas où il y ait plusieurs types de vitrages, j'en ai mis 5 mais on peut augmenter en copiant la ligne
 
For Each Cell In Selection
 
       If Cell.Value = "Vitrage 1" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage"
       End If
 
       If Cell.Value = "Vitrage 2" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage2"
       End If
 
       If Cell.Value = "Vitrage 3" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage3"
       End If
 
       If Cell.Value = "Vitrage 4" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage4"
       End If
 
       If Cell.Value = "Vitrage 5" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage5"
       End If
 
Next Cell
 
'On copie maintenant la valeur de la surface considérée par rapport au coefficient u
 
    Sheets("Perrenoud").Select
    Range("A" & lignef, "F" & ligneg).Select
    cpt = 2
 
For Each Cell In Selection
 
       If Cell.Value = (Sheets("Projet").Range("D" & cpt).Value) Then
       Sheets("Projet").Range("C" & cpt) = Cell.Offset(0, 2).Value
       cpt = cpt + 1
       End If
 
Next Cell
 
'Je comprends pas pourquoi la valeur de la dernière surface ne s'inscrit pas dans le tableau, j'ai fait varier l'ensemble des
'paramètres mais rien ne change
 
For Each Cell In Selection 'Je paramètre une zone d'action
 
       If Cell.Value = "CATALOGUE DES VITRAGES DE L'ETAT PROJET" Then
       ligneh = Cell.Row
       End If
       If Cell.Value = "ETAT PROJET : CALCUL du COEFFICIENT UBAT" Then
       lignei = Cell.Row
       End If
 
Next Cell
 
    Sheets("Perrenoud").Select
    Range("A" & ligneh, "B" & lignei).Select
 
For Each Cell In Selection
       If Cell.Value = "Désignation" Then
       Sheets("Projet").Range("B" & cpt) = Cell.Offset(2, 0).Value
       cpt = cpt + 1
       End If
Next Cell
 
End Sub

L'erreur qui me pose problème est pour cette ligne, dans l'état projet:

Code :

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

1
2
    Sheets("Perrenoud").Select
    Range("A" & lignef, "A" & ligneg).Select

Pourtant lignef et ligneg sont bien déclarées et existent bien, je ne vois vraiment pas d'où cela peut venir ..

Désolé pour la barbarie du message et merci de ton aide en tout cas

**keygen08** · 20/03/2013, 17h24

Bonjour
Un début de réponse sur ton autre post
sinon une version corriger de ton code, celui ci tourne, a toi de verifier si le resultat est correct.
Je te laisse le plaisir d'effacer les commentaires

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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
Sub Récupération_données()
 
' Récupération_données Macro
Dim selection As Range
Dim Cell As Variant
Dim cpt As Integer
Dim Somme_Vitrage As Single
Dim ligne As Integer
Dim lignea As Integer
Dim ligneb As Integer
Dim lignec As Integer
Dim ligned As Integer
Dim lignee As Integer
Dim lignef As Integer
Dim ligneg As Integer
Dim ligneh As Integer
Dim lignei As Integer
'Délimitation de la zone d'activité
    cpt = 2
    Set selection = Sheets("Perrenoud").Range("A1:a800")
 
    With selection
        Set c = .Find("CATALOGUE DES PAROIS DE L'ETAT PROJET", LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then ligne = c.Row
 
'For Each Cell In selection
        'If Cell.Value = "CATALOGUE DES PAROIS DE L'ETAT PROJET" Then
        'ligne = Cell.Row
        'End If
'Next Cell
    'End With
 
'Début des boucles permettant de définir le nom des surfaces, leur coefficient U ainsi que leur garde-fou
 
    'Range("A1:G" & ligne).Select
 
For Each Cell In Feuil1.Range("A1:G" & ligne)
 
        If Cell.Value = "Mur extérieur (A1)" Then
        Sheets("Initial").Range("A" & cpt) = "Mur extérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Mur intérieur (A1)" Then
        Sheets("Initial").Range("A" & cpt) = "Mur intérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plancher intérieur (A4)" Then
        Sheets("Initial").Range("A" & cpt) = "Plancher intérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
'Problème dans le fichier Perrenoud, il s'agit d'un  plancher intérieur sur VS mais test pour voir si cela fonctionne
' bien penser à modifier pour après
 
        If Cell.Value = "Plancher extérieur (A4)" And InStr(1, Cell.Offset(0, 1).Value, "VS", 0) Then
        Sheets("Initial").Range("A" & cpt) = "Plancher sur vide sanitaire"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.4
        cpt = cpt + 1
        ElseIf Cell.Value = "Plancher extérieur (A4)" And Not InStr(1, Cell.Offset(0, 1).Value, "VS", 0) Then
        Sheets("Initial").Range("A" & cpt) = "Plancher sur extérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.36
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plancher sur terre-plein (A4)" Then
        Sheets("Initial").Range("A" & cpt) = "Plancher sur terre-plein"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.41
        cpt = cpt + 1
        End If
 
        If InStr(1, Cell.Value, "Plafond extérieur (A3)", 0) Then
        Sheets("Initial").Range("A" & cpt) = "Toiture"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.34
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond intérieur RT2000 (A3)" Then
        Sheets("Initial").Range("A" & cpt) = "Plafond intérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.28
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond ext. légers (A2)" Then
        Sheets("Initial").Range("A" & cpt) = "Toiture extérieure légere"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond intérieur (A2)" Then
        Sheets("Initial").Range("A" & cpt) = "Plafond intérieur"
        Sheets("Initial").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Initial").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
Next Cell
 
'On fait la même chose pour le vitrage en commençant par délimiter la zone d'activité
        Set c = .Find("ETAT INITIAL : CALCUL du COEFFICIENT UBAT", LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then lignea = c.Row
'For Each Cell In selection
'       If Cell.Value = "ETAT INITIAL : CALCUL du COEFFICIENT UBAT" Then
'       lignea = Cell.Row
'       End If
        Set c = .Find("ETAT INITIAL : CALCUL du COEFFICIENT UBAT", LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then ligneb = c.Row
 
'       If Cell.Value = "RECAPITULATIF des SURFACES des BAIES" Then
'       ligneb = Cell.Row
'       End If
 
'Next Cell
 
 
 
'Par précaution au cas où il y ait plusieurs types de vitrages, j'en ai mis 5 mais on peut augmenter en copiant la ligne
 
For Each Cell In Feuil1.Range("A" & lignea, "F" & ligneb)
 
       If Cell.Value = "Vitrage 1" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage"
       End If
 
       If Cell.Value = "Vitrage 2" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage2"
       End If
 
       If Cell.Value = "Vitrage 3" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage3"
       End If
 
       If Cell.Value = "Vitrage 4" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage4"
       End If
 
       If Cell.Value = "Vitrage 5" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Initial").Range("C" & cpt) = Somme_Vitrage
       Sheets("Initial").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Initial").Range("E" & cpt) = 2.5
       Sheets("Initial").Range("A" & cpt) = "Vitrage5"
       End If
 
Next Cell
 
'On copie maintenant la valeur de la surface considérée par rapport au coefficient u
 
cpt = 2
 
For Each Cell In selection
       If Cell.Value = (Sheets("Initial").Range("D" & cpt).Value) Then
       Sheets("Initial").Range("C" & cpt) = Cell.Offset(0, 2).Value
       cpt = cpt + 1
       End If
Next Cell
 
'Je comprends pas pourquoi la valeur de la dernière surface ne s'inscrit pas dans le tableau, j'ai fait varier l'ensemble des
'paramètres mais rien ne change
 
        Set c = .Find("CATALOGUE DES VITRAGES DE L'ETAT INITIAL", LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then lignec = c.Row
 
 
'For Each Cell In selection 'Je paramètre une zone d'action
 
       'If Cell.Value = "CATALOGUE DES VITRAGES DE L'ETAT INITIAL" Then
       'lignec = Cell.Row
       'End If
        Set c = .Find("CATALOGUE DES VITRAGES DE L'ETAT INITIAL", LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then ligned = c.Row
       'If Cell.Value = "ETAT INITIAL : CALCUL du COEFFICIENT UBAT" Then
       'ligned = Cell.Row
       'End If
 
'Next Cell
 
 
 
For Each Cell In Feuil1.Range("A" & lignec, "B" & ligned)
       If Cell.Value = "Désignation" Then
       Sheets("Initial").Range("B" & cpt) = Cell.Offset(2, 0).Value
       cpt = cpt + 1
       End If
Next Cell
 
'L'erreur range m'empêche de savoir si le code est bon, ma zone d'action n'arrive pas à se définir
 
'Macro qui concerne l'état projet
 
 cpt = 2
 
        Set c = .Find("CATALOGUE DES PAROIS DE L'ETAT PROJET", LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then lignee = c.Row
'For Each Cell In selection
'        If Cell.Value = "CATALOGUE DES PAROIS DE L'ETAT PROJET" Then
'        lignee = Cell.Row
'        End If
'Next Cell
 
'Début des boucles permettant de définir le nom des surfaces, leur coefficient U ainsi que leur garde-fou
 
 
 
For Each Cell In Feuil1.Range("A" & lignee & ":a800")
 
        If Cell.Value = "Mur extérieur (A1)" Then
        Sheets("Projet").Range("A" & cpt) = "Mur extérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Mur intérieur (A1)" Then
        Sheets("Projet").Range("A" & cpt) = "Mur intérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plancher intérieur (A4)" Then
        Sheets("Projet").Range("A" & cpt) = "Plancher intérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
'Problème dans le fichier Perrenoud, il s'agit d'un  plancher intérieur sur VS mais test pour voir si cela fonctionne
' bien penser à modifier pour après
 
        If Cell.Value = "Plancher extérieur (A4)" And InStr(1, Cell.Offset(0, 1).Value, "VS", 0) Then
        Sheets("Projet").Range("A" & cpt) = "Plancher sur vide sanitaire"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.4
        cpt = cpt + 1
        ElseIf Cell.Value = "Plancher extérieur (A4)" And Not InStr(1, Cell.Offset(0, 1).Value, "VS", 0) Then
        Sheets("Projet").Range("A" & cpt) = "Plancher sur extérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.36
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plancher sur terre-plein (A4)" Then
        Sheets("Projet").Range("A" & cpt) = "Plancher sur terre-plein"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.41
        cpt = cpt + 1
        End If
 
        If InStr(1, Cell.Value, "Plafond extérieur (A3)", 0) Then
        Sheets("Projet").Range("A" & cpt) = "Toiture"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.34
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond intérieur RT2000 (A3)" Then
        Sheets("Projet").Range("A" & cpt) = "Plafond intérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.28
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond ext. légers (A2)" Then
        Sheets("Projet").Range("A" & cpt) = "Toiture extérieure légere"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
        If Cell.Value = "Plafond intérieur (A2)" Then
        Sheets("Projet").Range("A" & cpt) = "Plafond intérieur"
        Sheets("Projet").Range("B" & cpt) = Cell.Offset(0, 1).Value
        Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 2).Value
        Sheets("Projet").Range("E" & cpt) = 0.45
        cpt = cpt + 1
        End If
 
Next Cell
 
'On fait la même chose pour le vitrage en commençant par délimiter la zone d'activité
        Set c = .Find("ETAT PROJET : CALCUL du COEFFICIENT UBAT", LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then lignef = c.Row
'For Each Cell In selection
 
'       If Cell.Value = "ETAT PROJET : CALCUL du COEFFICIENT UBAT" Then
'       lignef = Cell.Row
'       End If
        Set c = .Find("RECAPITULATIF des SURFACES des BAIES", LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then ligneg = c.Row
'       If Cell.Value = "RECAPITULATIF des SURFACES des BAIES" Then
'       ligneg = Cell.Row
'       End If
 
'Next Cell
 
 
 
'Par précaution au cas où il y ait plusieurs types de vitrages, j'en ai mis 5 mais on peut augmenter en copiant la ligne
 
For Each Cell In Feuil1.Range("A" & lignef & ":F" & ligneg)
 
       If Cell.Value = "Vitrage 1" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage"
       End If
 
       If Cell.Value = "Vitrage 2" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage2"
       End If
 
       If Cell.Value = "Vitrage 3" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage3"
       End If
 
       If Cell.Value = "Vitrage 4" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage4"
       End If
 
       If Cell.Value = "Vitrage 5" Then
       Somme_Vitrage = Somme_Vitrage + Cell.Offset(0, 2).Value
       Sheets("Projet").Range("C" & cpt) = Somme_Vitrage
       Sheets("Projet").Range("D" & cpt) = Cell.Offset(0, 3).Value
       Sheets("Projet").Range("E" & cpt) = 2.5
       Sheets("Projet").Range("A" & cpt) = "Vitrage5"
       End If
 
Next Cell
 
'On copie maintenant la valeur de la surface considérée par rapport au coefficient u
 
 
 
 
For Each Cell In Feuil1.Range("A" & lignef, "F" & ligneg)
cpt = 2
       If Cell.Value = (Sheets("Projet").Range("D" & cpt).Value) Then
       Sheets("Projet").Range("C" & cpt) = Cell.Offset(0, 2).Value
       cpt = cpt + 1
       End If
 
Next Cell
 
'Je comprends pas pourquoi la valeur de la dernière surface ne s'inscrit pas dans le tableau, j'ai fait varier l'ensemble des
'paramètres mais rien ne change
 
'For Each Cell In selection 'Je paramètre une zone d'action
        Set c = .Find("CATALOGUE DES VITRAGES DE L'ETAT PROJET", LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then ligneh = c.Row
       'If Cell.Value = "CATALOGUE DES VITRAGES DE L'ETAT PROJET" Then
       'ligneh = Cell.Row
       'End If
        Set c = .Find("CATALOGUE DES VITRAGES DE L'ETAT PROJET", LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then lignei = c.Row
       'If Cell.Value = "ETAT PROJET : CALCUL du COEFFICIENT UBAT" Then
       'lignei = Cell.Row
       'End If
 
'Next Cell
 
 
For Each Cell In Feuil1.Range("A" & ligneh, "B" & lignei)
       If Cell.Value = "Désignation" Then
       Sheets("Projet").Range("B" & cpt) = Cell.Offset(2, 0).Value
       cpt = cpt + 1
       End If
Next Cell
 
End With
Set selection = Nothing
 
End Sub

**Antony1812** · 20/03/2013, 18h21

Merci beaucoup Keygen08, je te dois une fière chandelle.

Il y a quelques petits trucs à modifier pour obtenir le résultat que j'attendais mais l'essentiel est là.

Merci encore vraiment !!!

Erreur "La méthode Range de l'objet global a échoué"

Macros et VBA Excel

Discussions similaires

Partager

Partager