Optimisation du temps d'exécution d'un code vba

Bonjour,

S'il vous plaît y'a mon code qui prends énormément de temps, des dizaines de minutes et je ne sais pas quoi faire exactement,

voici mon code: à savoir que dans ma feuille CUR S j'ai plus que 2000 lignes

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 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

Sheets("CUR S").Activate n = [a65000].End(xlUp).Row i = 4 Do While i <= n If Cells(i, "A") <> "" Then       If Cells(i, 21) > Sheets("Activités").Range("K2") Then DernLigne = Worksheets("Interventions").Range("A65536").End(xlUp).Row   Worksheets("Interventions").Range("A" & DernLigne).Offset(1, 0) = Cells(i, 1).Value Worksheets("Interventions").Range("B" & DernLigne).Offset(1, 0) = Cells(i, 2).Value Worksheets("Interventions").Range("C" & DernLigne).Offset(1, 0) = Cells(i, 3).Value Worksheets("Interventions").Range("D" & DernLigne).Offset(1, 0) = Cells(i, 7).Value Worksheets("Interventions").Range("E" & DernLigne).Offset(1, 0) = Cells(i, 10).Value Worksheets("Interventions").Range("F" & DernLigne).Offset(1, 0) = Cells(i, 19).Value Worksheets("Interventions").Range("G" & DernLigne).Offset(1, 0) = Cells(i, 21).Value     End If   i = i + 1 End If Loop Sheets("Interventions").Activate Cells.EntireRow.AutoFit Sheets("Divers").Activate     n = [a65000].End(xlUp).Row i = 2 Do While i <= n If Cells(i, "A") <> "" Then       If Cells(i, 2) <> "Type de Travail" Then DernLigne = Worksheets("Interventions B").Range("A65536").End(xlUp).Row Worksheets("Interventions B").Range("A" & DernLigne).Offset(1, 0) = Cells(i, 1).Value Worksheets("Interventions B").Range("B" & DernLigne).Offset(1, 0) = Cells(i, 2).Value Worksheets("Interventions B").Range("C" & DernLigne).Offset(1, 0) = Cells(i, 3).Value Worksheets("Interventions B").Range("D" & DernLigne).Offset(1, 0) = Cells(i, 7).Value Worksheets("Interventions B").Range("E" & DernLigne).Offset(1, 0) = Cells(i, 10).Value Worksheets("Interventions B").Range("F" & DernLigne).Offset(1, 0) = Cells(i, 19).Value Worksheets("Interventions B").Range("G" & DernLigne).Offset(1, 0) = Cells(i, 21).Value     End If   i = i + 1 End If Loop

---

Déjà, tu pourrais faire des indentations un peu propre pour que ton code soit plus lisible.

Ensuite, tu devrais déclarer tes variables : des Long, c'est beaucoup plus rapide que des Variant (type par défaut des variables non déclarées).

Enfin, il n'y a pas besoin de recalculer systématiquement la dernière ligne quand on remplit une liste. Il suffit de faire un suivi et d'incrémenter la variable.

Ton code un peu nettoyé :

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 29 30 31 32 33

Dim i As Long, Ligne As Long   Ligne = Worksheets("Interventions").Cells(Rows.Count, 1).End(xlUp).Row + 1   Sheets("CUR S").Activate For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 1) <> "" And Cells(i, 21) > Sheets("Activités").Range("K2") Then Worksheets("Interventions").Cells(Ligne, 1).Value = Cells(i, 1).Value Worksheets("Interventions").Cells(Ligne, 2).Value = Cells(i, 2).Value Worksheets("Interventions").Cells(Ligne, 3).Value = Cells(i, 3).Value Worksheets("Interventions").Cells(Ligne, 4).Value = Cells(i, 7).Value Worksheets("Interventions").Cells(Ligne, 5).Value = Cells(i, 10).Value Worksheets("Interventions").Cells(Ligne, 6).Value = Cells(i, 19).Value Worksheets("Interventions").Cells(Ligne, 7).Value = Cells(i, 21).Value Ligne = Ligne + 1 End If Next i   Sheets("Divers").Activate For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, 1) <> "" And Cells(i, 21) > Sheets("Activités").Range("K2") Then Worksheets("Interventions").Cells(Ligne, 1).Value = Cells(i, 1).Value Worksheets("Interventions").Cells(Ligne, 2).Value = Cells(i, 2).Value Worksheets("Interventions").Cells(Ligne, 3).Value = Cells(i, 3).Value Worksheets("Interventions").Cells(Ligne, 4).Value = Cells(i, 7).Value Worksheets("Interventions").Cells(Ligne, 5).Value = Cells(i, 10).Value Worksheets("Interventions").Cells(Ligne, 6).Value = Cells(i, 19).Value Worksheets("Interventions").Cells(Ligne, 7).Value = Cells(i, 21).Value Ligne = Ligne + 1 End If Next i   Sheets("Interventions").UsedRange.EntireRow.AutoFit

---