Macro - Récupération de données dans plusieurs feuilles et rassemblement en une seule

**Duardo** · 27/10/2016, 15h29

Haha effectivement j'étais allé un peu fort sur les ws.

Maintenant que j'ai réglé ces erreurs, une nouvelle apparait ... :

Erreur d'exécution '1004': La méthode Select de la classe Range a échoué.

Un jour tout marchera !!

Voici le code :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
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
Sub ALPHA_all()
 
    For Each ws In activeWorkbook.Worksheets
    If ws.Name = "Feuil1" Or ws.Name = "Feuil3" Then
 
      ws.Columns("A:A").Select
      ws.Range(Selection, activeCell.SpecialCells(xlLastCell)).Select
      Selection.Cut
      ws.Range("R1").Select
      activeSheet.Paste
      ws.Columns("AE:AE").Select
      Selection.Cut
      ws.Columns("A:A").Select
      activeSheet.Paste
      ws.Columns("S:S").Select
      Selection.Cut
      ws.Columns("B:B").Select
      activeSheet.Paste
      ws.Columns("U:U").Select
      Selection.Cut
      ws.Columns("C:C").Select
      activeSheet.Paste
      ws.Columns("V:V").Select
      Selection.Cut
      ws.Columns("D:D").Select
      activeSheet.Paste
      ws.Columns("X:X").Select
      Selection.Cut
      ws.Columns("E:E").Select
      activeSheet.Paste
      ws.Columns("AA:AA").Select
      Selection.Cut
      ws.Columns("F:F").Select
      activeSheet.Paste
      ws.Columns("AB:AB").Select
      Selection.Cut
      ws.Columns("G:G").Select
      activeSheet.Paste
      ws.Columns("AG:AG").Select
      Selection.Cut
      ws.Columns("H:H").Select
      activeSheet.Paste
      ws.Columns("T:T").Select
      Selection.Cut
      ws.Columns("I:I").Select
      activeSheet.Paste
      ws.Columns("AD:AD").Select
      Selection.Cut
      ws.Columns("J:J").Select
      activeSheet.Paste
      ws.Columns("AM:AM").Select
      Selection.Cut
      ws.Columns("K:K").Select
      activeSheet.Paste
      ws.Columns("AN:AN").Select
      Selection.Cut
      ws.Columns("L:L").Select
      activeSheet.Paste
      ws.Columns("AO:AO").Select
      Selection.Cut
      ws.Columns("M:M").Select
      activeSheet.Paste
      ws.Columns("AP:AP").Select
      Selection.Cut
      ws.Columns("N:N").Select
      activeSheet.Paste
      ws.Columns("O:O").Select
      ws.Range(Selection, activeCell.SpecialCells(xlLastCell)).Select
      Selection.ClearContents
      With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
      End With
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      Selection.Borders(xlEdgeLeft).LineStyle = xlNone
      Selection.Borders(xlEdgeTop).LineStyle = xlNone
      Selection.Borders(xlEdgeBottom).LineStyle = xlNone
      Selection.Borders(xlEdgeRight).LineStyle = xlNone
      Selection.Borders(xlInsideVertical).LineStyle = xlNone
      Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
      ws.Range("A1").Select
      ws.Range(Selection, activeCell.SpecialCells(xlLastCell)).Select
      With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
      End With
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      Selection.Borders(xlEdgeLeft).LineStyle = xlNone
      Selection.Borders(xlEdgeTop).LineStyle = xlNone
      Selection.Borders(xlEdgeBottom).LineStyle = xlNone
      Selection.Borders(xlEdgeRight).LineStyle = xlNone
      Selection.Borders(xlInsideVertical).LineStyle = xlNone
      Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
      ws.Range("A1").Select
      ws.Range(Selection, activeCell.SpecialCells(xlLastCell)).Select
      Selection.Font.Bold = False
      Selection.Font.Bold = True
      Selection.Font.Bold = False
      With Selection.Font
            .Name = "Calibri"
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
      End With
      With Selection.Font
            .Name = "Calibri"
            .Size = 9
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
      End With
      With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
      End With
      With Selection.Font
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
      End With
      ws.Range("A1").Select
      ws.Range(Selection, Selection.End(xlToRight)).Select
      With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent5
            .TintAndShade = 0.599993896298105
            .PatternTintAndShade = 0
      End With
      Selection.Font.Bold = True
      ws.Range("O1").Select
    End If
  Next ws
End Sub

**Jean-Philippe André** · 27/10/2016, 15h59

Bon je fais un peu de nettoyage par la meme occasion =]

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
 
Dim LstCut As Variant
    Dim i As Integer
    For Each ws In activeWorkbook.Worksheets
    If ws.Name = "Feuil1" Or ws.Name = "Feuil3" Then
        ws.Activate
        ws.Range("A1").Activate
        ws.Columns("A:A").Select
        ws.Range(Selection, activeCell.SpecialCells(xlLastCell)).Select
        Selection.Cut
        ws.Range("R1").Select
        ActiveSheet.Paste
        LstCut = Array("AE:AE", "S:S", "U:U", "V:V", "X:X", "AA:AA", "AB:AB", "AG:AG", "T:T", "AD:AD", "AM:AM", "AN:AN", "AO:AO", "AP:AP")
        For i = 0 To 13
            ws.Columns(LstCut(i)).Cut
            ws.Columns(i + 1).Select
            ActiveSheet.Paste
        Next i
      ws.Columns("O:O").Select
'etc.

Essaie de faire un mode pas a pas (F8) et si ca plante, de me dire a quelle ligne stp =]

**Duardo** · 27/10/2016, 16h13

Que dire.. si ce n'est WAHOO ÇA ROULE COMME SUR DES ROULETTES et c'est beaucoup PLUS PROPRE !
Ma Macro a avancé à grands pas avec ton aide Jean-Philippe, merci beaucoup

**Jean-Philippe André** · 27/10/2016, 16h32

Pas de quoi,

si on est bon, tu peux basculer en

et courir acheter mon livre sur VBA Access 2016

**Duardo** · 28/10/2016, 10h23

On est presque parfait, j'aurais peut-être encore un ou deux petits trucs à demander sur ce sujet.

Alors j'ai voulu ajouter une autre condition à ma Macro, exécuter d'autres actions sur une feuille portant tel nom et le hic désormais :

Pas de For pour mon Next ws en bas de page]

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
Sub BE_EOC_ES_FOREIGN_FR_IT_LONDON()
 
Dim LstCut As Variant
    Dim i As Integer
    For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = "BE" Or ws.Name = "EOC EUR" Or ws.Name = "ES" Or ws.Name = "FOREIGN" Or ws.Name = "FR" Or ws.Name = "IT" Then
        ws.Activate
        ws.Range("A1").Activate
        ws.Columns("A:A").Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Cut
        ws.Range("R1").Select
        ActiveSheet.Paste
        LstCut = Array("AE:AE", "S:S", "U:U", "V:V", "X:X", "AA:AA", "AB:AB", "AG:AG", "T:T", "AD:AD", "AM:AM", "AN:AN", "AO:AO", "AP:AP")
        For i = 0 To 13
            ws.Columns(LstCut(i)).Cut
            ws.Columns(i + 1).Select
            ActiveSheet.Paste
        Next i
      ws.Columns("O:O").Select
 
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.ClearContents
            With Selection.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        ws.Range("A1").Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        ws.Range("A1").Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Font.Bold = False
        Selection.Font.Bold = True
        Selection.Font.Bold = False
            With Selection.Font
                .Name = "Calibri"
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .TintAndShade = 0
                .ThemeFont = xlThemeFontNone
            End With
            With Selection.Font
                .Name = "Calibri"
                .Size = 9
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .TintAndShade = 0
                .ThemeFont = xlThemeFontNone
            End With
            With Selection.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
            End With
        ws.Range("A1").Select
        ws.Range(Selection, Selection.End(xlToRight)).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent5
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0
            End With
        Selection.Font.Bold = True
        ws.Range("O1").Select
    End If
 
    If ws.Name = "LONDON" Then
        ws.Columns("A:A").Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Cut
        ws.Range("P1").Select
        ActiveSheet.Paste
        ws.Columns("T:T").Select
        Selection.Cut
        ws.Columns("A:A").Select
        ActiveSheet.Paste
        ws.Columns("P:P").Select
        Selection.Cut
        ws.Columns("B:B").Select
        ActiveSheet.Paste
        ws.Columns("X:X").Select
        Selection.Cut
        ws.Columns("C:C").Select
        ActiveSheet.Paste
        ws.Columns("Y:Y").Select
        Selection.Cut
        ws.Columns("D:D").Select
        ActiveSheet.Paste
        ws.Columns("AC:AC").Select
        Selection.Cut
        ws.Columns("E:E").Select
        ActiveSheet.Paste
        ws.Columns("U:U").Select
        Selection.Cut
        ws.Columns("F:F").Select
        ActiveSheet.Paste
        ws.Columns("Z:Z").Select
        Selection.Cut
        ws.Columns("G:G").Select
        ActiveSheet.Paste
        ws.Columns("AA:AA").Select
        Selection.Cut
        ws.Columns("H:H").Select
        ActiveSheet.Paste
        ws.Columns("AK:AK").Select
        Selection.Cut
        ws.Columns("I:I").Select
        ActiveSheet.Paste
        ws.Columns("AQ:AQ").Select
        Selection.Cut
        ws.Columns("J:J").Select
        ActiveSheet.Paste
        ws.Columns("AL:AL").Select
        Selection.Cut
        ws.Columns("L:L").Select
        ActiveSheet.Paste
        ws.Columns("O:O").Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.ClearContents
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
            With Selection.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
            End With
        ws.Range("A1").Select
        ActiveCell.FormulaR1C1 = "Trade Date"
        ws.Range("B1").Select
        ActiveCell.FormulaR1C1 = "FO Id"
        ws.Range("C1").Select
        ActiveCell.FormulaR1C1 = "Product Description"
        ws.Range("E1").Select
        ActiveCell.FormulaR1C1 = "Nominal"
        ws.Range("F1").Select
        ActiveCell.FormulaR1C1 = "Value Date"
        ws.Range("G1").Select
        ActiveCell.FormulaR1C1 = "Counterparty Code"
        ws.Range("H1").Select
        ActiveCell.FormulaR1C1 = "Counterparty Name"
        ws.Range("I1").Select
        ActiveCell.FormulaR1C1 = "Sales Name"
        ws.Range("J1").Select
        ActiveCell.FormulaR1C1 = "Additionnal Comments"
        ws.Range("K1").Select
        ActiveCell.FormulaR1C1 = "Settlement"
        ws.Range("L1").Select
        ActiveCell.FormulaR1C1 = "Tsf Status"
        ws.Range("M1").Select
        ActiveCell.FormulaR1C1 = "Return_Text"
        ws.Range("N1").Select
       ActiveCell.FormulaR1C1 = "Return_Status"
        ws.Columns("A:A").Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
            With Selection.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
            End With
        Selection.Font.Bold = False
        Selection.Font.Bold = True
        Selection.Font.Bold = False
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
        ws.Range("A1").Select
        ws.Range(Selection, Selection.End(xlToRight)).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent5
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0
            End With
        Selection.Font.Bold = True
            With Selection.Font
                .Name = "Calibri"
                .Size = 9
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .ThemeFont = xlThemeFontMinor
            End With
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
            With Selection.Font
                .Name = "Calibri"
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .ThemeFont = xlThemeFontMinor
            End With
            With Selection.Font
                .Name = "Calibri"
                .Size = 9
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .ThemeFont = xlThemeFontMinor
            End With
        ws.Columns("O:O").Select
Next ws
End Sub

**halaster08** · 28/10/2016, 10h37

Bonjour,

Il te manque un end if.
VBA a la facheuse manie de ne pas indiquer le bon message d'erreur.

**Duardo** · 28/10/2016, 10h43

Je viens de rajouter un End If à l'avant avant dernière ligne de mon code.
Désormais j'ai cette erreur :

Erreur d'execution '1004': La méthode Select de la classe Range a échoué

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
Sub BE_EOC_ES_FOREIGN_FR_IT_LONDON()
 
Dim LstCut As Variant
    Dim i As Integer
    For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = "BE" Or ws.Name = "EOC EUR" Or ws.Name = "ES" Or ws.Name = "FOREIGN" Or ws.Name = "FR" Or ws.Name = "IT" Then
        ws.Activate
        ws.Range("A1").Activate
        ws.Columns("A:A").Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Cut
        ws.Range("R1").Select
        ActiveSheet.Paste
        LstCut = Array("AE:AE", "S:S", "U:U", "V:V", "X:X", "AA:AA", "AB:AB", "AG:AG", "T:T", "AD:AD", "AM:AM", "AN:AN", "AO:AO", "AP:AP")
        For i = 0 To 13
            ws.Columns(LstCut(i)).Cut
            ws.Columns(i + 1).Select
            ActiveSheet.Paste
        Next i
      ws.Columns("O:O").Select
 
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.ClearContents
            With Selection.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        ws.Range("A1").Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        ws.Range("A1").Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Font.Bold = False
        Selection.Font.Bold = True
        Selection.Font.Bold = False
            With Selection.Font
                .Name = "Calibri"
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .TintAndShade = 0
                .ThemeFont = xlThemeFontNone
            End With
            With Selection.Font
                .Name = "Calibri"
                .Size = 9
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .TintAndShade = 0
                .ThemeFont = xlThemeFontNone
            End With
            With Selection.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
            End With
        ws.Range("A1").Select
        ws.Range(Selection, Selection.End(xlToRight)).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent5
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0
            End With
        Selection.Font.Bold = True
        ws.Range("O1").Select
    End If
 
    If ws.Name = "LONDON" Then
        ws.Columns("A:A").Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Cut
        ws.Range("P1").Select
        ActiveSheet.Paste
        ws.Columns("T:T").Select
        Selection.Cut
        ws.Columns("A:A").Select
        ActiveSheet.Paste
        ws.Columns("P:P").Select
        Selection.Cut
        ws.Columns("B:B").Select
        ActiveSheet.Paste
        ws.Columns("X:X").Select
        Selection.Cut
        ws.Columns("C:C").Select
        ActiveSheet.Paste
        ws.Columns("Y:Y").Select
        Selection.Cut
        ws.Columns("D:D").Select
        ActiveSheet.Paste
        ws.Columns("AC:AC").Select
        Selection.Cut
        ws.Columns("E:E").Select
        ActiveSheet.Paste
        ws.Columns("U:U").Select
        Selection.Cut
        ws.Columns("F:F").Select
        ActiveSheet.Paste
        ws.Columns("Z:Z").Select
        Selection.Cut
        ws.Columns("G:G").Select
        ActiveSheet.Paste
        ws.Columns("AA:AA").Select
        Selection.Cut
        ws.Columns("H:H").Select
        ActiveSheet.Paste
        ws.Columns("AK:AK").Select
        Selection.Cut
        ws.Columns("I:I").Select
        ActiveSheet.Paste
        ws.Columns("AQ:AQ").Select
        Selection.Cut
        ws.Columns("J:J").Select
        ActiveSheet.Paste
        ws.Columns("AL:AL").Select
        Selection.Cut
        ws.Columns("L:L").Select
        ActiveSheet.Paste
        ws.Columns("O:O").Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.ClearContents
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
            With Selection.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
            End With
        ws.Range("A1").Select
        ActiveCell.FormulaR1C1 = "Trade Date"
        ws.Range("B1").Select
        ActiveCell.FormulaR1C1 = "FO Id"
        ws.Range("C1").Select
        ActiveCell.FormulaR1C1 = "Product Description"
        ws.Range("E1").Select
        ActiveCell.FormulaR1C1 = "Nominal"
        ws.Range("F1").Select
        ActiveCell.FormulaR1C1 = "Value Date"
        ws.Range("G1").Select
        ActiveCell.FormulaR1C1 = "Counterparty Code"
        ws.Range("H1").Select
        ActiveCell.FormulaR1C1 = "Counterparty Name"
        ws.Range("I1").Select
        ActiveCell.FormulaR1C1 = "Sales Name"
        ws.Range("J1").Select
        ActiveCell.FormulaR1C1 = "Additionnal Comments"
        ws.Range("K1").Select
        ActiveCell.FormulaR1C1 = "Settlement"
        ws.Range("L1").Select
        ActiveCell.FormulaR1C1 = "Tsf Status"
        ws.Range("M1").Select
        ActiveCell.FormulaR1C1 = "Return_Text"
        ws.Range("N1").Select
       ActiveCell.FormulaR1C1 = "Return_Status"
        ws.Columns("A:A").Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
            With Selection.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With Selection.Font
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
            End With
        Selection.Font.Bold = False
        Selection.Font.Bold = True
        Selection.Font.Bold = False
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
        ws.Range("A1").Select
        ws.Range(Selection, Selection.End(xlToRight)).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent5
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0
            End With
        Selection.Font.Bold = True
            With Selection.Font
                .Name = "Calibri"
                .Size = 9
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .ThemeFont = xlThemeFontMinor
            End With
        ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
            With Selection.Font
                .Name = "Calibri"
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .ThemeFont = xlThemeFontMinor
            End With
            With Selection.Font
                .Name = "Calibri"
                .Size = 9
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .ThemeFont = xlThemeFontMinor
            End With
        ws.Columns("O:O").Select
    End If    
Next ws
End Sub

**halaster08** · 28/10/2016, 11h04

J'ai oublié ma boule de cristal à la maison, peux tu indiquer sur quel ligne se produit l'erreur?

A quoi sert le ws.Columns("O:O").Select, juste avant le next ws ?

J'ai trouvé ça aussi

Code :

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

1
2
3
4
 
Selection.Font.Bold = False
Selection.Font.Bold = True
Selection.Font.Bold = False

Seule la dernière ligne suffit, non?

**Duardo** · 28/10/2016, 11h17

OULA oui je sais que mon code est bien sale mais ce ne sont pas ces lignes qui créent l'erreur ici..
Je vais nettoyer tout ça une fois mon problème résolu !!

Alors ma Macro fonctionne uniquement si je la lance de ma feuille s'appelant LONDON, si j'ai le malheur de la lancer depuis une autre feuille l'erreur Erreur d'exécution '1004': La méthode Select de la classe Range a échoué. arrive à la ligne 109.

Comment puis-je résoudre ceci afin de pour exécuter ma Macro depuis n'importe quelle feuille ?

**halaster08** · 28/10/2016, 11h39

Essaye de rajouter un ws.Activate

Code :

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

1
2
3
4
 
If ws.Name = "LONDON" Then
ws.Activate
ws.Columns("A:A").Select

**Duardo** · 28/10/2016, 13h28

Merci beaucoup tout marche jusqu'ici maintenant

Une dernière question pour conclure mon post :

Comment puis-je retourner le résultat de cette Macro dans un nouveau Classeur avec la possibilité de choisir son nom de création (comme déjà fait ici pour une nouvelle feuille) au lieu de la retourner dans une nouvelle feuille ce classeur ?

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub COMBINE()
    Dim i As Integer
    Dim resultName As Variant
    Dim xWs As Worksheet
    On Error Resume Next
LInput:
    Set xWs = ActiveWorkbook.Worksheets.Add(Sheets(1))
    xWs.Name = Application.InputBox("Result sheet name", "BNP Paribas", "Resultat")
    Worksheets(2).RANGE("A1").EntireRow.Copy Destination:=xWs.RANGE("A1")
    For i = 2 To Worksheets.Count
        Worksheets(i).RANGE("A1").CurrentRegion.Offset(CInt(1), 0).Copy _
               Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, 1)
    Next
End Sub

Merci pour tout

**halaster08** · 28/10/2016, 13h38

Lance ta macro qui crée la nouvelle, une fois celle ci terminée, allume l'enregistreur de macro, clic droit sur ta feuille deplacer dans un nouveau classeur, sauvegarder le nouveau classeur, éteindre l'enregistreur, comprendre le code obtenu.

**Duardo** · 28/10/2016, 13h55

Je ne savais pas que l'enregistreur prenait compte de telles actions !!

Merci

Macro - Récupération de données dans plusieurs feuilles et rassemblement en une seule [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager