XL 2021 Taille fichier xlsm

Sub Nettoie()
    Dim Sht As Worksheet, DCell As Range, Calc As Long, Rien As String, Avant As Double, plage As Range
    On Error Resume Next
    showuse
    Calc = Application.Calculation ' ---- mémorisation del 'état de recalcul
    '------------------------------------------------------------
    MsgBox "Pour le classeur actif : " _
            & vbLf & ActiveWorkbook.FullName _
            & vbLf & "dans chaque feuille de calcul" _
            & vbLf & "recherche la zone contenant des données ," _
            & vbLf & "réinitialise la dernière cellule utilisée " _
            & vbLf & "et optimise la taille du fichier Excel", _
            vbInformation, "d'après LL par Gee...@m6net.fr"
    '-------------------------------------------------------------
    MsgBox "Taille initiale de ce classeur en octets" _
            & vbLf & FileLen(ActiveWorkbook.FullName), _
            vbInformation, ThisWorkbook.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 :" _
            & vbLf & Sht.Name _
            & vbLf & Format(Sht.UsedRange.Cells.Count / Avant, "0.00%") & " de la taille initiale", _
        vbInformation, ActiveWorkbook.FullName
    Next Sht
    '--------------------Message fin de traitement
    MsgBox "Taille optimisée de ce classeur en octets " _
            & vbLf & FileLen(ActiveWorkbook.FullName), _
            vbInformation, ThisWorkbook.FullName
    '--------------------
    Application.StatusBar = False
    Application.Calculation = Calc
    MsgBox "done"
    Debug.Print "Après optimisation " & String(40, "-")
    showuse
End Sub
Sub showuse()
    For Each sh In Worksheets
        Debug.Print Left(sh.Name & Space(40), 25), sh.UsedRange.Address
    Next
    Debug.Print vbLf, vbLf
End Sub