Accélérer l'exécution d'une macro (boucle)

Version imprimable

Bonjour,

j'essaie de copier une liste de lignes depuis une feuille à une autre. mon premier tableau que je copie peux aller jusqu’à 5000 lignes et cela prend énormément de temps pour s’exécuter ( plus de 10 min)

Code:

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
Sub remonter_stock()
 
Application.ScreenUpdating = False
 
Dim wb As Workbook
 
 
der_ligne_stock = ThisWorkbook.Worksheets("copie extract stock").Range("A122222").End(xlUp).Row
X = 2
 
For i = 4 To der_ligne_stock
 
 
        Worksheets("vérification affichage").Range("X" & X) = ThisWorkbook.Worksheets("copie extract stock").Range("A" & i)
        Worksheets("vérification affichage").Range("Y" & X) = ThisWorkbook.Worksheets("copie extract stock").Range("B" & i)
        Worksheets("vérification affichage").Range("Z" & X) = ThisWorkbook.Worksheets("copie extract stock").Range("C" & i)
        Worksheets("vérification affichage").Range("AA" & X) = ThisWorkbook.Worksheets("copie extract stock").Range("D" & i)
        Worksheets("vérification affichage").Range("AB" & X) = ThisWorkbook.Worksheets("copie extract stock").Range("R" & i)
        Worksheets("vérification affichage").Range("AC" & X) = ThisWorkbook.Worksheets("copie extract stock").Range("X" & i)
 
 
        X = X + 1
 
 
Next i
 
Application.ScreenUpdating = True
End Sub

est t'il possible de minimiser le temps d’exécution de la macro ? je ne trouve pas d'autre solution pour copier/coller le tableau sans passer par une boucle

Merci d'avance pour votre aide !

05/06/2019, 17h32
MarcelG
Salut,

Pourquoi une boucle?
Un objet Range peut être composé de plusieurs cellules.

On peut donc très bien coder
Code:

1 2 Range("A1:A10").Value = Range("B1:B10").Value
(au rattachement des objets près)

Parallèlement, l'un des moyens de diminuer le temps d'exécution d'une procédure consiste à désactiver la mise à jour de l'écran.
(Je te laisse traduire en VBA)

Bonjour,

Essaies :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
Sub remonter_stock()
Dim c As Integer, d As Long, f As Long
  Application.ScreenUpdating = False
  c = Application.Calculation
  Application.Calculation = xlCalculationManual
  d = ThisWorkbook.Worksheets("copie extract stock").Range("A122222").End(xlUp).Row
  f = d - 2
  With Worksheets("vérification affichage")
    .Range("X2:AA" & f).Value = ThisWorkbook.Worksheets("copie extract stock").Range("A4:D" & d).Value
    .Range("AB2:AB" & f).Value = ThisWorkbook.Worksheets("copie extract stock").Range("R4:R" & d).Value
    .Range("AC2:AC" & f).Value = ThisWorkbook.Worksheets("copie extract stock").Range("X4:X" & d).Value
  End With
  Application.Calculation = c
  Application.ScreenUpdating = True
End Sub

Déjà, je ne vois pas l'intérêt de ta variable X.
Dans tes Ranges, tu peux la remplacer par (i - 2).
Mais c'est pas ça qui fera gagner du temps.

Par contre, ceci en fera gagner :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub remonter_stock()
 
Dim WSSource As Worksheet, WSDest As Worksheet
Dim Lig As Long
 
Application.ScreenUpdating = False
 
Set WSSource = ThisWorkbook.Worksheets("copie extract stock")
Set WSDest = Worksheets("vérification affichage")
 
Lig = WSSource.Cells(Rows.Count, 1).End(xlUp).Row
 
WSSource.Range("A4:D" & Lig).Copy
WSDest.Range("X2").PasteSpecial(xlPasteValues)
 
WSSource.Range("R4:R" & Lig).Copy
WSDest.Range("AB2").PasteSpecial(xlPasteValues)
 
WSSource.Range("X4:X" & Lig).Copy
WSDest.Range("AC2").PasteSpecial(xlPasteValues)
 
Application.ScreenUpdating = True
End Sub

Sans certitude, ceci aussi pourrait fonctionner :

Code:

1
2
3
4
5
6
7
8
9
Sub remonter_stock()
Dim WSSource As Worksheet, Lig As Long
 
Set WSSource = ThisWorkbook.Worksheets("copie extract stock")
Lig = WSSource.Cells(Rows.Count, 1).End(xlUp).Row
 
WSSource.Range("A4:D" & Lig & ",R4:R" & Lig & ",X4:X" & Lig).Copy
Worksheets("vérification affichage").Range("X2").PasteSpecial(xlPasteValues)
End Sub

06/06/2019, 09h44
fzayoubi

Merci à vous tous pour votre aide !

le code de Menhir est top :)