stopper macro à la derniere ligne saisie

**infoclp81** · 01/08/2017, 09h43

Bonjour,

j'ai créé une macro VBA Excel. Elle est très longue à effectuer car elle tourne même sur les lignes vides....
Quelle est la ligne de code à ajouter pour qu'elle s'arrête à la dernière ligne saisie?

merci,

cordialement,

Pierre Baqué.

**halaster08** · 01/08/2017, 10h01

Bonjour,

Sans voir ton code il est difficile de t'aider.

**infoclp81** · 01/08/2017, 10h08

Merci.

1.

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
Sub M_Mise_en_Page()
'
' M_Mise_en_Page Macro
'
 
'
    Columns("C:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:H").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=18
    Columns("Y:Y").Select
    Selection.Delete Shift:=xlToLeft
    Columns("X:X").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Cells.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("1:1").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.AutoFilter
    ActiveWindow.SmallScroll ToRight:=6
    Columns("L:N").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Jour PCH"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Mois PCH"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Annee PCH"
    Columns("L:N").Select
    Range("N1").Activate
    Selection.NumberFormat = "General"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=DAY(RC[-1])"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=MONTH(RC[-2])"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=YEAR(RC[-3])"
    Range("L2:N2").Select
    Selection.AutoFill Destination:=Range("L2:N353430")
    Range("L2:N353430").Select
    ActiveWindow.SmallScroll ToRight:=14
    Columns("Z:Z").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Z1").Select
    ActiveCell.FormulaR1C1 = "Région de livraison"
    Range("Z2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC24,R_Régions!C1:C2,2,0)"
    Columns("AA:AA").Select
    Columns("Z:Z").ColumnWidth = 10.57
    Columns("Z:Z").EntireColumn.AutoFit
    Range("Z2").Select
    Selection.AutoFill Destination:=Range("Z2:Z353430")
    Range("Z2:Z353430").Select
    ActiveWindow.ScrollRow = 447
    ActiveWindow.ScrollRow = 2672
    ActiveWindow.ScrollRow = 4007
    ActiveWindow.ScrollRow = 12463
    ActiveWindow.ScrollRow = 15579
    ActiveWindow.ScrollRow = 28041
    ActiveWindow.ScrollRow = 31156
    ActiveWindow.ScrollRow = 59640
    ActiveWindow.ScrollRow = 72547
    ActiveWindow.ScrollRow = 95691
    ActiveWindow.ScrollRow = 113938
    ActiveWindow.ScrollRow = 156219
    ActiveWindow.ScrollRow = 173577
    ActiveWindow.ScrollRow = 200726
    ActiveWindow.ScrollRow = 249683
    ActiveWindow.ScrollRow = 271046
    ActiveWindow.ScrollRow = 298195
    ActiveWindow.ScrollRow = 309767
    ActiveWindow.ScrollRow = 334246
    ActiveWindow.ScrollRow = 338696
    ActiveWindow.ScrollRow = 353384
    ActiveWindow.ScrollRow = 347153
    ActiveWindow.ScrollRow = 312437
    ActiveWindow.ScrollRow = 295970
    ActiveWindow.ScrollRow = 157555
    ActiveWindow.ScrollRow = 131296
    ActiveWindow.ScrollRow = 107262
    ActiveWindow.ScrollRow = 69432
    ActiveWindow.ScrollRow = 21365
    ActiveWindow.ScrollRow = 9348
    ActiveWindow.ScrollRow = 2
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    Range("L2:N2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll ToRight:=4
    Columns("R:R").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "famille dernier flashage"
    Range("R2").Select
    ActiveWindow.SmallScroll Down:=-15
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],R_EVT!R[3]C[-17]:R[319]C[-12],6,0)"
    Range("R2").Select
    Selection.AutoFill Destination:=Range("R2:R353430")
    Range("R2:R353430").Select
    ActiveWindow.ScrollRow = 447
    ActiveWindow.ScrollRow = 1337
    ActiveWindow.ScrollRow = 8903
    ActiveWindow.ScrollRow = 14689
    ActiveWindow.ScrollRow = 44063
    ActiveWindow.ScrollRow = 53854
    ActiveWindow.ScrollRow = 99696
    ActiveWindow.ScrollRow = 116164
    ActiveWindow.ScrollRow = 166011
    ActiveWindow.ScrollRow = 178473
    ActiveWindow.ScrollRow = 222089
    ActiveWindow.ScrollRow = 232326
    ActiveWindow.ScrollRow = 271046
    ActiveWindow.ScrollRow = 279948
    ActiveWindow.ScrollRow = 301756
    ActiveWindow.ScrollRow = 302646
    ActiveWindow.ScrollRow = 303536
    ActiveWindow.ScrollRow = 303981
    ActiveWindow.ScrollRow = 304871
    ActiveWindow.ScrollRow = 310212
    ActiveWindow.ScrollRow = 312437
    ActiveWindow.ScrollRow = 313328
    ActiveWindow.ScrollRow = 313773
    ActiveWindow.ScrollRow = 307987
    ActiveWindow.ScrollRow = 288404
    ActiveWindow.ScrollRow = 197611
    ActiveWindow.ScrollRow = 155329
    ActiveWindow.ScrollRow = 104147
    ActiveWindow.ScrollRow = 90795
    ActiveWindow.ScrollRow = 77443
    ActiveWindow.ScrollRow = 75663
    ActiveWindow.ScrollRow = 69432
    ActiveWindow.ScrollRow = 50739
    ActiveWindow.ScrollRow = 16914
    ActiveWindow.ScrollRow = 8903
    ActiveWindow.ScrollRow = 2
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC17,R_EVT!R5C1:R321C6,6,0)"
    Range("R2").Select
    Selection.AutoFill Destination:=Range("R2:R353430")
    Range("R2:R353430").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("R10").Select
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll ToRight:=7
    Columns("K:N").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Columns("O:T").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    ActiveWindow.SmallScroll ToRight:=4
    Range("U31").Select
    ActiveWindow.SmallScroll ToRight:=6
    Columns("W:AB").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("AC4").Select
End Sub

**halaster08** · 01/08/2017, 10h50

Peux-tu mettre ton code entre balise code (bouton #), c'est illisible sinon.

Visiblement tu a fait ton code a partir de l'enregistreur de macro.
Sais tu a quoi sert cette ligne:

Code :

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

ActiveWindow.ScrollColumn = 13

En as-tu vraiment besoin? idem pour la vingtaine d'autres lignes similaires.

**halaster08** · 01/08/2017, 12h17

Pour accélerer ta macro tu peut déjà commencer par virer tout tes select inutile.
L'enregistreur de macro c'est bien, mais il faut nettoyer le code.

Code :

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

ActiveWindow.ScrollColumn = 13

C'est complètement inutile

Code :

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

1
2
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Jour PCH"

s'écrit

Code :

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

 Range("L1").= "Jour PCH"

pour ton histoire de ligne vide, j'imagine que c'est ici

Code :

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

1
2
    Range("Z2").Select
    Selection.AutoFill Destination:=Range("Z2:Z353430")

Où tu copie ta formule jusqu'a la ligne 353430
remplace ces lignes par:

Code :

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

1
2
dl = range("Y" & rows.count).end(xlup).row 'calcul du numéro de la dernière de ligne de la colonne Y
Range("Z2").AutoFill Destination:=Range("Z2:Z" & dl)' permet de remplir la colonne Z sur autant de lignes que la colonne Y

J'ai pris la colonne Y car c'est celle qui est avant Z mais tu peux prendre la colonne de ton choix

Tu peux aussi ajouter en début de code

Code :

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

Application.Calculation = xlCalculationManual

pour bloquer le calcul automatique pendant ta macro
Ne pas oublié en fin de code de le remettre en automatique

Code :

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

Application.Calculation = xlCalculationAutomatic

stopper macro à la derniere ligne saisie

Macros et VBA Excel

Discussions similaires

Partager

Partager