Option Explicit
Public Sub Nettoie()
'd'après LL par <!-- e --><a href="mailto:GeeDee@m6net.fr">GeeDee@m6net.fr</a><!-- e -->
Dim Sht As Worksheet, _
    DCell As Range, plage As Range, _
    Calc As Long, _
    Rien As String, _
    Avant As Double

    On Error Resume Next
    Calc = Application.Calculation    ' ---- mémorisation de l'état de recalcul
   '------------------------------------------------------------
   MsgBox "Pour le classeur actif : " _
         & Chr(10) & ActiveWorkbook.FullName _
         & Chr(10) & "dans chaque feuille de calcul" _
         & Chr(10) & "recherche la zone contenant des données," _
         & Chr(10) & "réinitialise la dernière cellule utilisée" _
         & Chr(10) & "et optimise la taille du fichier Excel", _
           vbInformation
    '-------------------------------------------------------------
   MsgBox "Taille initiale de ce classeur en octets" _
         & Chr(10) & FileLen(ActiveWorkbook.FullName), _
           vbInformation, ActiveWorkbook.FullName
    '------------------------------------------------------------
   With Application
        .Calculation = xlCalculationManual
        .StatusBar = "Nettoyage en cours..."
        .EnableCancelKey = xlErrorHandler
        .ScreenUpdating = True
    End With
    '-------------------- le traitement
   For Each Sht In Worksheets
        Avant = Sht.UsedRange.Cells.Count
        Application.StatusBar = Sht.Name & "-" & Sht.UsedRange.Address
        '-------------------Traitement de la zone trouvée
       If Sht.UsedRange.Address <> "$A$1" Or Not IsEmpty(Sht.[A1]) Then
            Set DCell = Sht.Cells.Find("*", , , , xlByRows, xlPrevious)(2)
            '----------------Suppression des lignes inutilisées
           If Not DCell Is Nothing Then
                Sht.Range(DCell, Sht.Cells([A:A].Count, 1)).EntireRow.Delete
                Set DCell = Nothing
                Set DCell = Sht.Cells.Find("*", , , , xlByColumns, xlPrevious)(, 2)
                '----------------Suppression des colonnes inutilisées
               If Not DCell Is Nothing Then Sht.Range(DCell, Sht.[IV1]).EntireColumn.Delete
            End If
            Rien = Sht.UsedRange.Address
        End If
        ActiveWorkbook.Save
        '---------------------Message pour la feuille traitée
       MsgBox "Nom de la feuille de calcul :" _
             & Chr(10) & Sht.Name _
             & Chr(10) & Format(Sht.UsedRange.Cells.Count / Avant, "0.00%") _
             & " de la taille initiale", vbInformation, ActiveWorkbook.FullName
    Next Sht
    On Error GoTo 0
    '--------------------Message fin de traitement
   MsgBox ActiveWorkbook.FullName & Chr(10) & "Taille optimisée de ce classeur en octets " & _
           Chr(10) & FileLen(ActiveWorkbook.FullName), vbInformation
    '--------------------
   Application.StatusBar = False
    Application.Calculation = Calc
End Sub