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
| Sub NettoieEtDerniereCellule() ' Laurent Longre
Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String
On Error Resume Next
Calc = Application.Calculation
With Application
.Calculation = xlCalculationManual
.StatusBar = "Nettoyage en cours..."
.EnableCancelKey = xlErrorHandler
.ScreenUpdating = False
End With
For Each Sht In Worksheets
If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
If Not DCell Is Nothing Then
Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Clear
Set DCell = Nothing
Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
If Not DCell Is Nothing Then _
Sht.Range(DCell, Sht.[IV1]).EntireColumn.Clear
End If
Rien = Sht.UsedRange.Address
End If
Next Sht
Application.StatusBar = False
Application.Calculation = Calc
End Sub |
Partager