Bonjour

Pour les besoins d'un développement, il faut que j'insère des lignes pour effectuer des sous-totaux. Mais cela ralentit beaucoup (plusieurs minutes) la macro.

Ce qui est très étonnant, c'est que si je mets en pause la macro (j'appuie sur la touche Echap), puis que je la continue, et ceci 2-3 fois, et bien la macro ne prends que 50 secondes.

50 secondes quand je la mets en pause puis la relance et 10 minutes si elle continue toute seule Il y a quelque chose que je ne comprends pas
Quelle peut être la raison ?

Le code incriminé boucle sur les lignes en partant du bas, effectue un test et insère une ligne et des formules. Le tout en ayant, bien entendu, Application.ScreenUpdating = False et Application.Calculation = xlManual

Voici la partie du code qui me pose souci :
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
 
Dim OCPL As Worksheet 'Feuille sur laquelle on travaille
Dim ASelectLigs As Long 'Nombre de lignes de cette plage
Dim ASelectCols As Byte 'Nombre de colonnes de cette plage
Dim LigDeb As Byte 'Première ligne où on inscrit les valeurs
Dim LigMax As Long 'Dernière ligne des valeurs
Dim LigFinTask As Long 'Dernière ligne des Tasks identiques
Dim LigFinJob As Long 'Dernière ligne des Jobs identiques
Dim ColDeb As Byte 'Première colonne où les données de base sont inscrites
Dim LigDates As Byte 'Ligne sur laquelle seront inscrit les dates
Dim ColMontants As Byte 'Première colonne sur laquelle seront inscrits les montants
Dim i As Long
Dim j As Long
 
'il y a du code ici qui ne pose pas de souci
 
LigFinTask = ASelectLigs + LigDeb - 1
LigFinJob = ASelectLigs + LigDeb - 1
For i = ASelectLigs + LigDeb - 1 To LigDeb Step -1
   If OCPL.Cells(i, 9).Value <> OCPL.Cells(i - 1, 9) Then 'Si Job différent, alors insertion d'un sous-total Task et un sous-total Job
      Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
      OCPL.Cells(i, 9).Value = OCPL.Cells(i + 1, 9).Value
      OCPL.Cells(i, 10).Value = OCPL.Cells(i + 1, 10).Value
      OCPL.Range("K2:AH2").Copy
      OCPL.Range("K" & i & ":AH" & i).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      OCPL.Range(Cells(i, ColMontants), Cells(i, ColMontants + NbCols)).FormulaR1C1 = "=SUM(R" & i + 1 & "C:R" & LigFinTask + 1 & "C)"
      LigFinJob = LigFinJob + 1
      Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
      OCPL.Cells(i, 9).Value = OCPL.Cells(i + 1, 9).Value
      OCPL.Range("K1:AH1").Copy
      OCPL.Range("K" & i & ":AH" & i).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      OCPL.Range(Cells(i, ColMontants), Cells(i, ColMontants + NbCols)).FormulaR1C1 = "=SUM(R" & i + 1 & "C:R" & LigFinJob + 1 & "C)/2"
      LigFinTask = i - 1
      LigFinJob = i - 1
   ElseIf OCPL.Cells(i, 10).Value <> OCPL.Cells(i - 1, 10) Then 'Si Task différent, alors insertion d'un sous-total Task
      Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
      OCPL.Cells(i, 9).Value = OCPL.Cells(i + 1, 9).Value
      OCPL.Cells(i, 10).Value = OCPL.Cells(i + 1, 10).Value
      OCPL.Range("K2:AH2").Copy
      OCPL.Range("K" & i & ":AH" & i).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      OCPL.Range(Cells(i, ColMontants), Cells(i, ColMontants + NbCols)).FormulaR1C1 = "=SUM(R" & i + 1 & "C:R" & LigFinTask + 1 & "C)"
      LigFinTask = i - 1
      LigFinJob = LigFinJob + 1
   End If
Next i
 
'il y a du code après aussi bien sûr
Est-ce qu'il y a une zone mémoire qui se remplit et ne se vide pas ?
Quel est le truc bizarre que je n'arrive pas à voir ?

Merci d'avance aux fins limiers

Pierre Dumas