Sub GetShLen()
    Dim wbWork As Workbook
    Dim sTmpPath As String, sWorkFileName As String
    Dim wsSh, li As Long
    Dim dblLen As Double, dblShLen2 As Double, dblShLen As Double
    Dim avResLen()

    sTmpPath = "C:\" 'Environ("temp")
    If Right(sTmpPath, 1) <> "\" Then sTmpPath = sTmpPath & "\"

    sWorkFileName = sTmpPath & "templen_" & ActiveWorkbook.Name
    
    With Application
        .ScreenUpdating = 0
        .DisplayAlerts = 0
        .EnableEvents = 0
        .Calculation = xlCalculationManual
    End With
    ActiveWorkbook.SaveCopyAs sWorkFileName
    dblLen = FileLen(sWorkFileName)
    Set wbWork = Workbooks.Open(sWorkFileName, False)
    ReDim avResLen(1 To wbWork.Sheets.Count)
    wbWork.Sheets.Add wbWork.Sheets(1)
    For li = wbWork.Sheets.Count To 2 Step -1
        wbWork.Sheets(li).Delete
        wbWork.Save
        dblShLen2 = FileLen(sWorkFileName)
        dblShLen = dblLen - dblShLen2
        avResLen(li - 1) = dblShLen
        dblLen = dblShLen2
    Next li
    wbWork.Close 0
    Kill sWorkFileName
    
    Debug.Print "Размеры листов файла " & ActiveWorkbook.Name & ":"
    For li = UBound(avResLen) To LBound(avResLen) Step -1
        Debug.Print "Лист №" & li & " - " & avResLen(li) & " b"
    Next li
    
    With Application
        .ScreenUpdating = 1
        .DisplayAlerts = 1
        .EnableEvents = 1
        .Calculation = xlCalculationAutomatic
    End With
End Sub