Discussion :

[Muntjact]

Bonjour,

Mon problème c'est que j'ai une macro qui se lance sur mes 2 feuilles alors que je veux qu'elle se lance que sur la feuille 1.

Je ne sais pas comment faire pour l'empêcher qu'elle se lance sur la feuille 2.

Merci.

[MarcelG]

Bonjour et bienvenu sur le Forum,

Pour répondre à cette problématique, il suffit de bien définir et rattacher les objets.
Ce serait plus simple, par ailleurs, de retourner le code complet que tu souhaites modifier.

[Menhir]

Mon problème c'est que j'ai une macro qui se lance sur mes 2 feuilles alors que je veux qu'elle se lance que sur la feuille 1.
Je ne sais pas comment faire pour l'empêcher qu'elle se lance sur la feuille 2.

En début de macro, tu testes le nom de la feuille active et tu quittes la macro si ce nom ne convient pas.

Ca devrait donner quelque chose comme :

Code :

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

If ActiveSheet.Name <> "feuille 1" Then Exit Sub

A adapter à ton cas.

[Muntjact]

Merci la séparation fonctionne mais après ca n'exécute pas entièrement ma macro

[Patrice740]

Bonjour,

Merci la séparation fonctionne mais après ca n'exécute pas entièrement ma macro

Ça vient peut-être de la 6ème ligne (ma boule de cristal n'est pas très affirmative).

[Muntjact]

Ma boule de cristal me dis c'est de ça que tu as besoin

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
 Sub VOL_Hydro()
 
 
 If ActiveSheet.Name <> "Sheet1" Then Exit Sub
 
 
 
     stepline = 4
 
    Myfilexls = ActiveWorkbook.FullName
longueurnom = InStr(1, Myfilexls, ".")
 Myfile = Left(Myfilexls, longueurnom - 1)
 Mypath = ActiveWorkbook.Path
    longueurpath = Len(Mypath)
 mywin = Right(Myfilexls, (longueurnom - longueurpath + 2))
 
 
 
 
   'ouverture du fichier dia-sched pour lookup
 
   ' ChDir "\\M5510\E_ingr\sp3d\spec"
    Workbooks.Open Filename:="\\M5510\E_ingr\sp3d\spec\Dia-Sched.xls"
  '  ActiveWindow.WindowState = xlMinimized
    'ChDir "P:\2d\"
 
 
 
          'reponse = Application.Dialogs(xlDialogOpen).Show
    Windows(mywin).Activate
 
 
 
 ' affichage de toutes les lignes
    Cells.Select
    Selection.EntireRow.Hidden = False
 
 ' effacement des lignes dont la deuxième colonne est 'H'
    nligne = 1
    Range("A1").Select
    lignefin = Application.ActiveCell.SpecialCells(xlLastCell).Row
  Do While nligne < lignefin + 1
   Seleinit = Cells(nligne, 2).Value
 
   If Seleinit = "H" Then
     Rows(nligne).Select
     Selection.Delete
    lignefin = lignefin - 1
    Else
     nligne = nligne + 1
    End If
 Loop
 
  'Remplacement de la colonne alphanu des poids par une colonne numérique
    Columns("I:I").Select
    Selection.Copy
    Columns("K:K").Select
    ActiveSheet.Paste
    Selection.Replace What:="kg", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
  'Remise de kg dans l'entete et suppression de la colonne originale des poids
    Range("K7").Select
    ActiveCell.FormulaR1C1 = "kg"
 
    Columns("K:K").Select
    Application.CutCopyMode = False
    Selection.Cut
    Columns("I:I").Select
    ActiveSheet.Paste
 
      'Ajout de la somme totale des poids
   nline = lignefin + 1
   locsomme = "I" & nligne
    Range(locsomme).Select
    retour = nligne - 8
    zonesomme = "=SUM(R[-" & retour & "]C:R[-1]C)"
    ActiveCell.FormulaR1C1 = zonesomme
 
        Cells.Select
    Range("D1").Activate
    Selection.EntireColumn.Hidden = False
    Columns("A:C").Select
    Selection.Delete Shift:=xlToLeft
 
    'suppression de l'entete
 
 '   Rows("2:7").Select
    Rows("3:7").Select
    Selection.Delete Shift:=xlUp
    Rows("3:3").Select
    Selection.Insert Shift:=xlDown
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "VOLUME HYDRO"
    With ActiveCell.Characters(Start:=1, Length:=12).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
 
    'Insertion d'une colonne
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
 
 
 
   ' Suppresion du mm dans la colonne longueur
    pos = "E" & stepline
    Range(pos).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Replace What:="mm", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
 
    'Recalcul du nombre de ligne
 
    pos = "C" & 1
    Range(pos).Select
    Selection.End(xlDown).Select
    lastline = ActiveCell.Row
 
     'Traitement des lignes ou la longueur est inférieure à 5 mm
    ' et arrondi de la valeur au 100 mm supérieur
 
    nligne = 4
    Range("A1").Select
  Do While nligne < lastline + 1
   longmm = Cells(nligne, 5).Value
 
   If longmm < 5 Then
    Rows(nligne & ":" & nligne).Select
    Selection.Delete Shift:=xlUp
    lastline = lastline - 1
    Else
     nligne = nligne + 1
    End If
   Loop
        'selection de la zone  à traiter
    rangetraite = stepline & ":" & lastline
    Rows(rangetraite).Select
 
    'Tri sur la colonne C (code article complet)
    pos = "C" & stepline
    Selection.Sort Key1:=Range(pos), Order1:=xlAscending, Header:=xlGuess, _
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
       DataOption1:=xlSortNormal
 
    'placement de la fonction exact en colonne B et extension surles lignes significatives
    pos = "B" & stepline
    Range(pos).Select
    ActiveCell.FormulaR1C1 = "=EXACT(RC[1],R[1]C[1])"
    Range(pos).Select
    rangetire = pos & ":B" & lastline
    If lastline > stepline Then
     Selection.AutoFill Destination:=Range(rangetire), Type:=xlFillDefault
    End If
 
   'positionnement sur la dernière ligne de la colonne B
    positionstart = "B" & lastline
    Range(positionstart).Select
 
GoTo jump
    'Recherche des doublons via le code Vrai dans la colonne B
    ' et si doublon addition des quantité et supression d'une ligne
 
    nrow = lastline
   Do While nrow > stepline - 1
 
    celvaleur = Cells(nrow, 2).Value
 
 
   If celvaleur = "Faux" Then
     nrow = nrow - 1
    Else
      val1 = Cells(nrow, "E").Value
      val2 = Cells(nrow + 1, "E").Value
      valsum = val1 + val2
      posit = "E" & nrow
      Range(posit).Select
      ActiveCell.FormulaR1C1 = valsum
 
      Rows(nrow + 1).Select
      Selection.Delete
      nblineefface = nblineefface + 1
      nrow = nrow - 1
    End If
 Loop
 
 
    'Effacement du contenu de la colonne B
    Columns("B:B").Select
    Selection.Clear
 
    'décomposition du code en code famille et code article
   nrow = stepline
   Do While nrow < lastline - nblineefface + 1
    poscel = "C" & nrow
    Range(poscel).Select
    Selection.NumberFormat = "@"   ' format text pour la celulle
    longcell = Len(ActiveCell)
    longextrait = longcell - 4
    famille = Left(ActiveCell, longextrait)
    artid = Right(ActiveCell, 4)
    ActiveCell.FormulaR1C1 = artid
    poscel = "B" & nrow
    Range(poscel).Select
    ActiveCell.FormulaR1C1 = famille
    nrow = nrow + 1
   Loop
 
   'Mise en page
jump:
   lastline = lastline - nblineefface
 
   'déplacement de la colonne des diamètres après le descriptif
    Columns("A:A").Select
    Selection.Cut
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
 
 
 
    'Ajoute colonne pour calcul du volume
     Range("I" & stepline).Select                                          'ajout dans dernière colonne
    ActiveCell.FormulaR1C1 = _
        "=(LEFT(MID(RC[-6],FIND("","",RC[-6],1)+2,20),5))"
    Range("I" & stepline).Select
     If lastline > stepline Then
        Selection.AutoFill Destination:=Range("I" & stepline & ":I" & lastline), Type:=xlFillSeries
    End If
    Range("I" & stepline & ":I" & lastline).Select
    Selection.Copy
    Range("J" & stepline).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:=",", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
    Application.CutCopyMode = False
    Selection.Cut
    Range("I" & stepline).Select
    ActiveSheet.Paste
    Range("I3").Select
    ActiveCell.FormulaR1C1 = "SCH"
    Range("J" & stepline).Select
    ActiveCell.FormulaR1C1 = "=concatenate(RC[-6],(RC[-1]))"
    If lastline > stepline Then
        Selection.AutoFill Destination:=Range("J" & stepline & ":J" & lastline), Type:=xlFillSeries
    End If
    Range("K" & stepline).Select
 
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-1],'[Dia-Sched.xls]Feuil1'!R2C3:R250C6,4,FALSE)"  'attention accepte 250 lignes dans dia-sched
 
    If lastline > stepline Then
        Selection.AutoFill Destination:=Range("K" & stepline & ":K" & lastline), Type:=xlFillSeries
    End If
    Range("L" & stepline).Select
    ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-7]/1000000000"
 
    If lastline > stepline Then
        Selection.AutoFill Destination:=Range("L" & stepline & ":L" & lastline), Type:=xlFillSeries
    End If
 
    Range("L" & lastline + 1).Select
    zonesum = "=SUM(R[-" & lastline - 1 & "]C:R[-1]C)"
    ActiveCell.FormulaR1C1 = zonesum
    Columns("L:L").Select
    Selection.NumberFormat = "0.0000"
    Range("L1").Select
    With Selection
        .HorizontalAlignment = xlCenter
    End With
 
    Range("F1").Select
    Selection.Copy
    Range("G1").Select
    ActiveSheet.Paste
 
 
    Range("B:E,G:G,L:L").Select
    Range("L1").Activate
    Selection.Copy
    Sheets.Add.Name = "HYDRO"
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
 
 
 
 
    Rows("4:4").Select
    Selection.Insert Shift:=xlDown
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "Ident Code"
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "Description"
    Range("C4").Select
    ActiveCell.FormulaR1C1 = "DIA"
    Range("D4").Select
    ActiveCell.FormulaR1C1 = "Length (mm)"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "Weight (kg)"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "Vol  (M³)"
 
 
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "VOLUME HYDRO"
    With ActiveCell.Characters(Start:=1, Length:=12).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 20
    End With
    Columns("A:F").EntireColumn.AutoFit
    Rows("1:2").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
    End With
 
    Range("A1:F2").Select
    With Selection.Interior
        .ColorIndex = 6   'couleur jaune pour titre
        .Pattern = xlSolid
    End With
 
 '   zonetr = "F" & lastline + 2
     Range("F" & lastline + 2).Select
    Selection.Font.Bold = True
     With Selection.Interior
        .ColorIndex = 43
        .Pattern = xlSolid
    End With
 
     Range("A4:F4").Select
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.4
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlCenter
    End With
 
 
 
 '   Application.DisplayAlerts = False
 
 '    For Each sh In ThisWorkbook.Sheets
 
 
  '  If InStr(sh.Name, "SP3D") = 0 And InStr(sh.Name, "HYDRO") = 0 Then
  '      Sheets(sh.Name).Select
  '      ActiveWindow.SelectedSheets.Delete
 
  '  End If
 
'      Application.DisplayAlerts = True
 
 
'   Next
 
    Sheets("Sheet1").Select
    ActiveWindow.SelectedSheets.Delete
 
 
    Workbooks("Dia-Sched.xls").Close SaveChanges:=False
 
 
    On Error Resume Next
    ActiveWorbook.Save
  '  ActiveWorkbook.SaveAs Filename:=nameworkb, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
  Application.DisplayAlerts = False
   ' ActiveWorkbook.Saved = True    'Pour ne pas sauver l'original si un  fichier hydro existe déjà et que l'on n'a pas voulu le remplacer
  '  ActiveWorkbook.Close
    ActiveWorkbook.Close SaveChanges:=True
 '   Application.DisplayAlerts = False
 
sortie:
 
 '   ActiveWorkbook.Close           ' pour fermer dia-sched
 
norun:
 
 
 
 End Sub

[Menhir]

Merci la séparation fonctionne mais après ca n'exécute pas entièrement ma macro

Si ta macro fonctionnait pour la "Sheet1" auparavant, il n'y a pas de raison pour que ça ne continue pas avec cette ligne en plus.

Maintenant, si l'idée est de faire débuger ta macro avec comme seule indication ce "pas entièrement", il faudra d'abord commencer par faire un peu le ménage dedans.
C'est bourré de lignes inutiles mises en commentaire, de morceaux de code récupérés bruts de l'enregistreur automatique, de Goto, de Select et d'indentations aléatoires.
Essaye d'abord de faire un code propre et tu pourras mieux t'y retrouver.