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