copier le format d'une cellule

**fabrice44** · 09/05/2007, 10h53

bonjour,

voilà, je récupère des cellules d'un fichier pour les coller dans un autre mais je voudrais récupérer le format, la couleur, les bordures de la cellule, auriez vous une solution

d'avance merci !

code partiel

Code :

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

1
2
3
4
5
6
7
8
9
10
11
e = 3
Do While e <> 13
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop

**tonton fred** · 09/05/2007, 11h21

Bonjour,

Le copie-colle marcherait bien je pense.

Code :

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

1
2
3
4
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d).Select
Selection.Copy
Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1).Select
ActiveSheet.Paste

Peut etre existe-t-il un moyen plus propre de recuperer le format d'une cellule dans le meme esprit que .Address .Value .Formula ....

**ouskel'n'or** · 09/05/2007, 11h25

Pour cette ligne :

Code :

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

1
2
3
4
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1).Copy
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d).PasteSpecial _
      Paste:=xlPasteFormats

Maintenant, pour simplifier le code, j'instancierais les feuilles de calculs

Code :

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

1
2
3
4
5
6
7
8
9
Dim Fl1 as worksheet
Dim Fl2 as Worksheet
     Set Fl1 = Workbooks(g).Worksheets("Feuil1")
     Set Fl2 = Workbooks(nom).Worksheets("fc 2007")
 
     If Fl1.Cells(C, d)) = CDate(Fl2.Cells(e, f)) Then
          Fl1.Cells(C + 3, d) = Fl2.Cells(e, f + 1))
          Fl2.Cells(e, f + 1).Copy
          FL1.Cells(C + 3, d).PasteSpecial Paste:=xlPasteFormats

Si tu as une erreur sur la dernière ligne - je n'ai pas testé (!) - remplace par

Code :

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

          FL1.Cells(C + 3, d).PasteSpecial(Paste:=xlPasteFormats)

Tu dis
A+

**fabrice44** · 09/05/2007, 11h29

le problème de copier coller c'est que ca va etre trés lourd je cherche effectivement un truc plus propre du genre .format ou ????

le prob c'est que je n'ai pas le contenu de ma cellule je n'ai que le format !

**ouskel'n'or** · 09/05/2007, 11h42

Envoyé par fabrice44

le prob c'est que je n'ai pas le contenu de ma cellule je n'ai que le format !

??? Alors inverse les lignes mais là je t'avoue que je ne comprends pas.
Un copier/coller tel que je te l'ai écrit pèse moins lourd qu'un formatage de cellule, surtout si tu inclus les bordures... Ex

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
    Range("F9").NumberFormat = "[$-40C]dd-mmm-yyyy;@"
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With

Et là tu n'as qu'un format de date et les quatre bordures de la cellule.
Bref, je ne connais pas plus "léger" que la copie de format.
Désolé
Mais montre le code que tu utilises "en vrai" et qui ne fonctionne pas

**fabrice44** · 09/05/2007, 11h58

c'est bon ca fonctionne, merci pastexlall

**ouskel'n'or** · 09/05/2007, 12h03

Effectivement, pastexlall, ça fonctionne... Mais si tu as une formule dans une cellule copiée dans un autre classeur, non une simple valeur, regarde ce que devient ta formule

Tu risques des surprises.
Bonne chance et merci pour l'info

**fabrice44** · 09/05/2007, 14h09

je reviens suite à la discution de ce matin avec ouckelnor sur le problème du format cellule à copier dans un autre fichier

la solution que m' a donné ouckelnor fonctionne pour copier le format mais pas pour le contenu de la cellule alors j'ai remplacé "pasteformats" par "pasteall" et la pas bon l'ordi il aime pas

problème automation

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
C = 4
d = 3
e = 3
f = 13
Do While f <> 41
e = 3
Do While e <> 13
 
'On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1).Copy
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d).PasteSpecial Paste:=xlPasteFormats
 
'On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop

message d'erreur

erreur automation
l'objet invoqué s'est déconnecté de ses clients

c'est pas bon ca! non

**ouskel'n'or** · 09/05/2007, 14h47

Dans le code que tu nous as mis, tu as deux while et un loop, c'est comme ça dans ton code vrai ?

**fabrice44** · 09/05/2007, 14h51

je te mets le code en entier c'est un peu lourd a digérer mais bon !

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
'
' Macro1 Macro
Range("C6:FF26,FF30,FE31,C30:FF50,C54:IR85").Select
Selection.Clear
Cells(1, 1).Select
 
 
Dim a As Integer
a = 6
Dim b As Integer
b = 2
 
 
Do While a <> 24
 
a = a + 1
 
Dim nom As String
nom = Worksheets("Feuil1").Cells(a, b) & ".xls"
 
Dim nomfichier As String
nomfichier = "S:\Dossiers FC\DIVERS\congés\" & nom
 
If Worksheets("Feuil1").Cells(a, b) <> "" Then
Workbooks.Open Filename:=nomfichier
 
 
 
End If
 
Dim C As Integer 'c est la ligne de la cellule du fichier recap
Dim d As Integer 'd est la colonne de la cellule du fichier recap
Dim e As Integer 'e est la ligne de la cellule du tableau agent
Dim f As Integer 'f est la colonne de la cellule du tableau agent
 
Dim g As String
g = "tableau récapitulatif.xls"
 
 
'premiere ligne du tableau récap a partir de d=3
 
C = 4
d = 3
e = 3
f = 13
Do While f <> 41
e = 3
Do While e <> 13
 
'On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1).Copy
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d).PasteSpecial Paste:=xlPasteAll
'On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 24
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1).Copy
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d).PasteSpecial Paste:=xlAll
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 35
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 46
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
f = f + 2
Loop
 
'premiere ligne du tableau récap a partir de d=4
 
C = 4
d = 4
e = 4
f = 13
 
Do While f <> 41
e = 4
Do While e <> 14
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 25
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 36
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 47
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
f = f + 2
Loop
 
'deuxième ligne du tableau récap a partir de d=3
 
C = 28
d = 3
e = 3
f = 21
Do While f <> 41
e = 3
 
Do While e <> 13
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 24
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 35
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 46
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
f = f + 2
Loop
 
'deuxième ligne du tableau récap a partir de d=4
C = 28
d = 4
e = 4
f = 21
 
Do While f <> 41
e = 4
Do While e <> 14
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 25
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 36
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 47
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
f = f + 2
Loop
 
'troisieme ligne du tableau récap a partir de d=3
 
C = 52
d = 3
e = 3
f = 29
Do While f <> 41
e = 3
 
Do While e <> 13
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 24
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 35
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 46
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
f = f + 2
Loop
 
'troisieme ligne du tableau récap a partir de d=4
C = 52
d = 4
e = 4
f = 29
 
Do While f <> 41
e = 4
Do While e <> 14
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 25
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 36
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
 
e = e + 1
Do While e <> 47
 
On Error Resume Next
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d) = (Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1))
On Error GoTo 0
End If
e = e + 2
d = d + 2
Loop
f = f + 2
Loop
 
 
Workbooks(nom).Close False
 
Loop
 
 
End Sub

meme si ca parait un peu le bordel ca fonctionne comme je le souhaite le problème est juste depuis que j'essaye de récupérer les formats

**ouskel'n'or** · 09/05/2007, 15h00

En effet, cépaoptimisé (!!!) Bon, on a tous commencé par là. Essaie tout de même

Code :

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

1
2
3
4
If CDate(Workbooks(g).Worksheets("Feuil1").Cells(C, d)) = CDate(Workbooks(nom).Worksheets("fc 2007").Cells(e, f)) Then
Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1).Copy
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d).PasteSpecial Paste:=xlPasteFormats
Workbooks(g).Worksheets("Feuil1").Cells(C + 3, d).value = Workbooks(nom).Worksheets("fc 2007").Cells(e, f + 1)

Tu dis

**fabrice44** · 09/05/2007, 15h07

eh ben voilà! il suffisait de remettre la valeur de la cellule, ca c'est bien !

promis je vais faire un effort en matière de rangement et d'obtimisation (meme si je ne sais pas trop comment)

encore merci et a+

**ouskel'n'or** · 09/05/2007, 15h08

Attention : Une copie du format de cellule à cellule ne copie ni la hauteur de ligne, ni la largeur de colonne. Pour ça, tu dois définir l'un et l'autre indépendament.

**fabrice44** · 09/05/2007, 15h16

j'ai quand meme un vieux problème, j'ai mon excel, à chaque fois que je lance ma macro, il bug!
explication
je fini ma macro, je ferme le fichier vba

pardon fausse manip
bon donc je ferme mes fichiers mais impossible de fermer le logicie, je suis obligé de faire un ctrl alt suppr pour terminer la tâche, ou excel est en cours d'execution, ca te dis qque chose?