Discussion :

[Matrixmax]

Bonjour à tous ,

Je viens de développez ce code et je l'est isérer dans un boutoin activX dans la Feuil 3 de mon classeur Excel , Or quand j'ai recopier le code dedans dans un autre boutton dans la feuil 1 du méme classeur çà bug ... :/ ...

La ligne est indiqué au comentaire du code ci dessus :

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
 
 
'Code du bouton 1 de la feuil 3
 
Private Sub CommandButton1_Click()
 
Dim cell As Range
 
For Each cell In Range("C9:AH9")
 
If cell.Value = "Fils" Or cell.Value = "Vide" Then
 
 
cell.Select
'bug au niveau de cette ligne :/ et méme les ligne qui le suive quand je supprime méme la totalité de la ligne :( 
Columns(cell.Column).Select
Range(Selection, Selection.End(xlToRight)).Select
 
Selection.SpecialCells(xlCellTypeConstants, 23).Select
 
Selection.ClearContents
 
 
 
 
 
    End
 
End If
 
Next cell
 
 Sheets(3).Select
    ActiveSheet.Range("C18").Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets(4).Select
    ActiveSheet.Range("B15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Sheets(3).Select
    ActiveSheet.Range("C19").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
 
    Sheets(4).Select
    ActiveSheet.Range("B16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Columns("C:C").EntireColumn.AutoFit
 
    Sheets(3).Select
    ActiveSheet.Range("A1").Select
    Application.CutCopyMode = False
 
    Sheets(4).Select
    ActiveSheet.Rows("15:15").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.Rows("6:6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Range("A1").Select
    Application.CutCopyMode = False
 
 
    ActiveSheet.Cells.Select
    Selection.ColumnWidth = 7.5
 
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
     Sheets(4).Select
     ActiveSheet.Range("A1").Select
End Sub

Merci d'avance pour votre aide ...

[Daniel.C]

Bonjour,

Quel est le message d'erreur ?

[mercatog]

Evites les Select/ Selection. Elles sont la cause de tous les ennuis

Essaies comme ceci (aucun Select et aucune Selection)

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
Private Sub CommandButton1_Click()
Dim LastCol As Integer
Dim LastLig As Long
Dim Cel As Range
 
With Worksheets(3)
    For Each Cel In .Range("C9:AH9")
        If Cel.Value = "Fils" Or Cel.Value = "Vide" Then
            Cel.EntireColumn.SpecialCells(xlCellTypeConstants, 23).ClearContents
        End If
    Next Cel
 
    LastCol = .Cells(18, .Columns.Count).Column
    LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
    Worksheets(4).Range("B15").Resize(LastLig - 17, LastCol - 2).Value = .Range("C18").Resize(LastLig - 17, LastCol - 2).Value
End With
End Sub

A adapter

[Matrixmax]

MercaTog :=) ....

T'est mon hero toi ... Merci infiniment tu m'aide à chaque fois ... Tu me facilite la vie ...

Chapeau ^^

[Matrixmax]

Bonsoir MerCatog;

Puis-je te demander une ptite question ?? si çà ne te dérrange pas ,

Bon,

aprés avoir faire un long traitement de donnée sur un fichier excel importer puis traiter , j'obtient en finale un tableau de donnée sur la 4éme feuil de mon classeur auxquelle je fais un traitement de mise en forme .

Ma question c'est que puis je faire ce traitement sur une multiselection de fichiers excel et faire le méme traitement ên boucle sur chacun d'entre les fichier excel selectionnés

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
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
 
 
Private Sub CommandButton1_Click()
 
'Déclaration des varriable
 
Dim A As Variant
Dim C As Range
'Désactivation de la mise à jour de l'écran durant le temps de calcule de la macro
 
 
 
 
 
Application.ScreenUpdating = False
'Selection du fichier sujet de la manip
 
Sheets(2).Visible = True
 
A = Application.GetOpenFilename()
'condition sur la selection
 
If A = False Then
'msgboxe
 
    MsgBox " Aucun fichier n'a été selectionné"
'copy de la feuil de calcule
 
Else
    Range("A1:AG380").Select
    Selection.Clear
    Workbooks.Open(A).Worksheets(1).Range("A1:AG380").Copy
    ThisWorkbook.Activate
    ActiveSheet.Paste
    Workbooks.Open(A).Close
 
 
 
    Worksheets(1).Activate
    ActiveSheet.Range("A9").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Worksheets(2).Activate
    ActiveSheet.Range("C5").Select
 
    ActiveSheet.Paste
'Fin de la manip
 
 
 
'copie de la résistance intiale et finale
 
    Worksheets(1).Activate
    ActiveSheet.Range("A9").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
 
    Worksheets(2).Activate
    ActiveSheet.Range("C5").Select
    ActiveSheet.Paste
 
    Sheets("Mesure Bending").Select
    Range("B10").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
 
    Sheets("Calcul Resistance + Evolut Max").Select
    Sheets("Mesure Bending").Select
    Range("B367").Select
 
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
 
    Worksheets(2).Activate
    ActiveSheet.Range("D304").Select
    ActiveSheet.Paste
 
 
 'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B27").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D22").Select
    ActiveSheet.Paste
 
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B44").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D35").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B61").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D50").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("A67").Select
    ActiveSheet.Range("B78").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D63").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B95").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D78").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B112").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D91").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B129").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D106").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B146").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D119").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B163").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D134").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B180").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D147").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B197").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D162").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B214").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D175").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B231").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D190").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B248").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D203").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B265").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D218").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B282").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D231").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B299").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D246").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B316").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D259").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B333").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D274").Select
    ActiveSheet.Paste
'Cycle1
    Sheets("Mesure Bending").Select
    ActiveSheet.Range("B350").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Calcul Resistance + Evolut Max").Select
    ActiveSheet.Range("D287").Select
    ActiveSheet.Paste
 
'boucle pour la calcule de la valeur - val moyenne
With Sheets(2)
        For Each C In .Range(.[D22], .[AI229])
            If IsNumeric(C) And C.Value <> "" Then
                C.Value = C.Value - .Cells(19, C.Column)
            End If
        Next C
    End With
 
 
 
 
'copie des valeur vers la feuil des résultat
 
'1) Valeur de l'évolution maximale
 
        ActiveSheet.Range("D323").Select
        ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
        ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        Sheets("Résultat + Photo de montage").Select
        ActiveSheet.Range("C19").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
 '2) la moyenne de la résistance finale
 
 
        Sheets(2).Select
        ActiveSheet.Range("D317").Select
        ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
        Application.CutCopyMode = False
        Selection.Copy
 
        Sheets("Résultat + Photo de montage").Select
        ActiveSheet.Range("C12").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
 
'3) La moyenne de la résistance initiale
 
        Sheets("Calcul Resistance + Evolut Max").Select
        ActiveSheet.Range("D19").Select
        ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
        Application.CutCopyMode = False
        Selection.Copy
 
        Sheets("Résultat + Photo de montage").Select
        ActiveSheet.Range("C11").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
'4) Les référence des voies
 
        Sheets(2).Select
        ActiveSheet.Range("D5").Select
        ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
        Application.CutCopyMode = False
        Selection.Copy
 
        Sheets("Résultat + Photo de montage").Select
        ActiveSheet.Range("C9").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
 
'fin
 
MsgBox ("Cliquer sur 'OK' pour Trier les résultats de l'essais")
 
 
 
  Sheets(3).Select
 
    ActiveSheet.Range("C9").Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    ActiveSheet.Range("C18").Select
    ActiveSheet.Paste
    Sheets(1).Select
    ActiveSheet.Range("B8").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets(3).Select
    ActiveSheet.Range("C7").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
 
    ActiveSheet.Range("C7:AH29").Select
    ActiveWorkbook.Worksheets("Résultat + Photo de montage").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Résultat + Photo de montage").Sort.SortFields.Add _
        Key:=Range("C9:AH9"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Résultat + Photo de montage").Sort
        .SetRange Range("C7:AH29")
        .Header = xlGuess
        .MatchCase = True
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
 
 
 
    End With
        Sheets(2).Select
    ActiveWindow.SelectedSheets.Visible = False
 
 
Application.CutCopyMode = False
 
 
Dim LastCol As Integer
Dim LastLig As Long
Dim Cel As Range
 
With Worksheets(3)
    For Each Cel In .Range("C9:AH9")
        If Cel.Value = "Fils" Or Cel.Value = "Vide" Then
            Cel.EntireColumn.SpecialCells(xlCellTypeConstants, 23).ClearContents
        End If
    Next Cel
 
    LastCol = .Cells(18, .Columns.Count).Column
    LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
    Worksheets(4).Range("B15").Resize(LastLig - 17, LastCol - 2).Value = .Range("C18").Resize(LastLig - 17, LastCol - 2).Value
End With
 
Sheets(3).Select
    ActiveSheet.Range("C18").Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets(4).Select
    ActiveSheet.Range("B15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Sheets(3).Select
    ActiveSheet.Range("C19").Select
    ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
 
    Sheets(4).Select
    ActiveSheet.Range("B16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Columns("C:C").EntireColumn.AutoFit
 
    Sheets(3).Select
    ActiveSheet.Range("A1").Select
    Application.CutCopyMode = False
 
    Sheets(4).Select
    ActiveSheet.Rows("15:15").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.Rows("6:6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Range("A1").Select
    Application.CutCopyMode = False
 
 
    ActiveSheet.Cells.Select
    Selection.ColumnWidth = 7.5
 
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
 
     Sheets(4).Select
     ActiveSheet.Range("A1").Select
 
 
 Sheets(1).Select
ActiveSheet.Range("H1:N5").Select
Selection.Merge
Sheets(3).Select
ActiveSheet.Range("A1").Select
End If
 
 
 
 
 
End Sub

je veux aussi que les tableau résultant de l'enssemble des fichier soit coller l'un prés de l'autre sans avoire recoller la premiére colonne dans la 4éme feuil de mon classeur je joint mon classeur pour que tu puisse voir de proche mon travail ...



Je sais que ce code est embarquant et male structuré , mais c'est tous ce que j'ai pu développer jusqu'au moment ....

Merci d'avance chef

[mercatog]

Je vois que tu t'entête à utiliser les Select à tord et à travers.
Quand tu analyseras les propositions qu'on te donne, tu t'en sortiras tout seul.
Sauf si tu as trouvé en ce forum des gens bénévoles qui te donnent des solutions clef en main.

A toi donc de choisir entre obtenir de temps en temps des poissons ou d'apprendre à pêcher.

[Matrixmax]

Bonjour Mercatog,

J' fais chaque jour de mon mieux pour apprendre à programmer en VBA ,

Je te jure monsieur que j'étais ( çà fais méme pas deux mois) nuuuuule en programmation je ne connaissais méme pas qu'est ce que signifie ( sheeet , row ....) .

je voulais réduire la longeur de mon programme que je suis sure qu'il y'as plein de synthaxe peuvent étre changé par une seule plus simple et significative mais je ne sias pas coment.

concernant le sujet de "select" a t il autre chose à remplaçer par .

Je doit toujour faire des copier coller :/ .... d'une feuille à l'autre on passant par les autres feuilles ..

J'ai jusqu'au moment des notions de base sur la programmation mais pas au bout de faire un programme seule .. et sans Select ..

merci pour ton conseil .. une deuxiéme fois , et prêt à entendre d'autres de ta part !

[mercatog]

Bonjour Oussama

En ouvrant ton fichier et en regardant ton code, il y a beaucoup de modification à apporter et je suppose qu'il faut beaucoup plus de temps que de reprendre le tout à zéro d'une façon structurée.

Le but étant de décomposer les actions en de petites actions de même structure et paramétrées. C'est à dire au lieu d'écrire la même chose 2 fois pour copier 2 plages A et B, il suffit d'écrire une seule fois une sous procédure paramétrée laquelle on fait appel.

Si vous avez envie de prendre ce challenge, je suis (et avec moi le forum) sont prêt à vous aider à retravailler l'approche pour arriver à un résultat simple à maintenir et à faire évoluer.

Pour cela, on a besoin d'explications sur les fichiers que tu as et le résultat souhaité (On va partir pas à pas et dès le début).

[Matrixmax]

Bonjour Mercatog,

Je suis prét , et j'ai plein envie de prendre ce challenge monsieur

Voilà je vais t'expliquer le context dabord :

Cette MACRO est faite pour le bute de faciliter et réduire le temps de saisir les donnée et faire les calcules souhaitées ;

en revanche on est dans le cadre d'une machine ( cette machine fais des vibrations sur des 32 voies de fils qui ne sont toujours pas toutes branché et qui fais mesurer leur résistance à chaque 5 seconde pendant une durée de vibration de 60 seconde et celà se répéte 10 fois pour chaque lancement dans les deux sens A et B ) qui nous délivre un fichier excel à chaque lacement .

Le principe de la MACRO consiste à élaborer et faire des calcule (moyenne des copier coller de la résistance avant et aprés .... ) de la méme maniére , sur les fichiers excels importés ( exemple : celui dans la premiére feuil de calcule de mon classeur )

ensuite on doit trier les colonnes on se basant sur la ligne contenat simple number on mettant les tableaux résultants de chaque classeur l'un prés de l'autre selon l'ordre : simple number 1.1 1.2.1 1.2.2... 1.3 ....n.n.n ..

puis extraire les résultats utile et les mettre en forme on les collant l'un prét de l'autre ( exemple dans la 4éme feuil de calcule dans mon classeur contenant la MACRO )


Aprés avoir terminer ce faite je devrais exporter les donnée ver un fichier word sous forme de plage de donnée de 11 colonnée chacune tout on gardant la premiére colonne de donnée comprise dans tout les tableau exporter ....

J'espére bien étre le plus claire possible ... si vous avez des questions je serais content de vous répondre ..

Merci Chaleureusement d'avance....

[mercatog]

Première étape: Import de données d'un fichier externe vers la feuille Mesure Bending

L'utilisateur choisit un fichier Excel, le code l'ouvre, copie les données de la feuille 1 vers la feuille Mesure Bending et ferme le fichier.

Remarque, je propose d'utiliser une fonction paramétrée (pour la clarté)

Code à copier dans un module standard

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
Option Explicit
 
Sub Principale()
Dim LeFichier As Variant
 
LeFichier = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If ImportData(LeFichier) Then
 
'ici on va continuer le code pour les autres traitements
Else
    MsgBox "Aucun fichier n'est sélectionné", , "Annulation"
End If
End Sub
 
'------------------------------------------------------------------------------------------
'Fonction booléenne qui est VRAI lorsque l'import a réussi
'après avoir ouvert le fichier entré en paramètre, copié toutes les donnée de la feuille 1
'dans la feuille Mesure Bending et fermeture du fichier
'------------------------------------------------------------------------------------------
Private Function ImportData(ByVal Fichier As String) As Boolean
Dim Wbk As Workbook
 
If Dir(Fichier) <> "" Then
    Set Wbk = Workbooks.Open(Fichier)
    With ThisWorkbook.Worksheets("Mesure Bending")
        .UsedRange.Clear
        Wbk.Worksheets(1).UsedRange.Copy .Range("A1")
    End With
    Wbk.Close False
    Set Wbk = Nothing
    ImportData = True
End If
End Function

Code à tester et j’attends l'explication de l'action suivante.

[Matrixmax]

Bonjour,

çà marche trés bien ,

Comme indiqué dans la feuil jointe La deuxiéme étape consiste à élaborer et faire des calcule , la premiére feuil contien le fichier importé par la procédure que tu viens de cité monsieur .

Et la deuxiéme feuil contient les méme information contenant à la premiére avec une mise en place de donnée et des calcules de la moyenn de la résistance à l'initiale et la résistance au finale .

Et aussi faire un tableau synthétique en bas de la feuil contenant la valeur maximale de la résistance de chaque cycle dans les deux sens.

J'espére pour voire étre claire et que mon explication étais compréhensible

Ps : je joint un classeur contenant juste la premiére et la deuxiéme feuil
la deuxiéme feuil contient aussi des formule pour le calcule de la valeur moyenne aussi bien que la valeur max , je sais encore pas coment rendre ces formule en un code VBA :/ ...


Merci encore une fois .

[mercatog]

Dis toi que je ne connais rien de ton fichier ni de tes calculs.

J'attends des explication de ce que doit faire la macro pour arriver à engendrer le 2ème feuille.

Je regarderai le fichier ce soir, en espérant avoir plus d'éclaircissement. c'est à dire en copie quoi vers quoi et en fait quoi de chaque chose.

A la prochaine compatriote.

[Matrixmax]

Bonjour Mercatog,


J'ai bien pensé à tes proposition et je pense que çà serai mieux de faire le calcule sur la méme feuil ( si c'est possible) ; je te détaillerais le calcule voulu on mettant des couleur sur la feuil pour juste t'expliquer mieux la procédure de calcule.

1 ) calcule de la moyenne de chaque voies pour le premier tableau et le dernier tableau en orange dans les lignes A23 et A380

2)établir un tableau synthétique qu'on va utiliser dans la prochaine étape comme celui en fin de la feuil 1 (en bleu ) qui va conteir

A) entéte contient en premiére ligne le nuiméro de la voie et les références de chaque fil

B) calculer la valeur maximale pour chaque voie et chaque cycle pour les deux position (exemple en vert)


J'espére bine étre plus claire qu'auparavant, (':'( .. null en programmation et aussi en fraçais et en explication ... c'est vraiment ... ... !! )



sinon merci .. tu m'encourage de faire mieux .. !!