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 |
