Bonjour,

Le but de la macro est d'insérer une ligne vierge toutes les dix lignes en partant du bas des données, et cela pour les 41 feuilles du classeur. Je n'ai pas de problème avec Excel 32 bits mais mon utilisateur est obligé d'interrompre la macro au bout de dix minutes, l'insertion de lignes ne se faisant plus. Voici le code :

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
Sub LignesVides()
  Dim Fich As String, Wbk As Workbook, Arr As Variant, Sh As Worksheet
  Dim Ctr As Long
  Application.EnableCancelKey = xlInterrupt
  deb = Timer
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Fich = Application.GetOpenFilename("Classeurs (*.xlsx), *.xlsx")
  If Fich <> "Faux" Then
    Set Wbk = Workbooks.Open(Fich)
  Else
    GoTo Fin
  End If
  Arr = Array("1sf", "1sn", "1so", "2sf", "2sn", "2so", "3sf", "3sn", "3so", _
    "4sf", "4sn", "4so", "5sf", "5sn", "5so")
  For Each Item In Arr
    Sheets(Item).Visible = xlSheetVisible
  Next Item
  For Each Sh In Sheets
    With Sh
      DoEvents
      Debug.Print Sh.Name
      deb = Timer
 
'      Debug.Print GetMemUsage
      Ctr = 0
      For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If .Cells(i, 1).Value = "" Then .Rows(i).Delete
      Next i
      For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
          Ctr = Ctr + 1
          If Ctr = 10 Then
            Ctr = 0
            .Rows(i).Insert
            DoEvents
          End If
      Next i
    End With
    Debug.Print Timer - deb
  Next Sh
Fin:
  Arr = Array("1sf", "1sn", "1so", "2sf", "2sn", "2so", "3sf", "3sn", "3so", _
    "4sf", "4sn", "4so", "5sf", "5sn", "5so")
  For Each Item In Arr
    Sheets(Item).Visible = xlHidden
  Next Item
  Wbk.Close True
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  MsgBox Timer - deb
  MsgBox "Traitement terminé"
End Sub
Merci d'avance.