Size by Excel Worksheet


Sub SheetsSize()
    Dim a(), Bytes As Double, i As Long, FileNameTmp As String
    Dim Sh, Wb As Workbook
    Set Wb = ActiveWorkbook
    ReDim a(0 To Wb.Sheets.Count, 1 To 2)
    ' Turn off screen updating
    Application.ScreenUpdating = False
    On Error GoTo exit_
    ' Put names into a(,1) and sizes into a(,2)
    With CreateObject("Scripting.FileSystemObject")
        ' Build the temporary file nane
        FileNameTmp = .GetSpecialFolder(2) & "\" & Wb.Name & ".TMP"
        ' Save workbook
        Wb.SaveCopyAs FileNameTmp
        ' Put workbook's name and size into a(0,)
        a(0, 1) = Wb.Name
        a(0, 2) = .GetFile(FileNameTmp).Size
        ' Put each sheet name and its size into a(i,)
        For i = 1 To Wb.Sheets.Count
            a(i, 1) = Wb.Sheets(i).Name
            Wb.Sheets(i).Copy
            ActiveWorkbook.SaveCopyAs FileNameTmp
            
            a(i, 2) = .GetFile(FileNameTmp).Size
            Bytes = Bytes + a(i, 2)
            ActiveWorkbook.Close False
        Next
        Kill FileNameTmp
    End With
    ' Show workbook's name & size
    Debug.Print a(0, 1), Format(a(0, 2), "# ### ### ##0") & " Bytes"
    ' Show each sheet name and its corrected size
    For i = 1 To UBound(a)
        Debug.Print a(i, 1), Format(a(0, 2) * a(i, 2) / Bytes, "# ### ### ##0") & " Bytes"
    Next
exit_:
    ' Restore screen updating and show error reason if happened
    Application.ScreenUpdating = True
    ' Show the reason of error if happened
    If Err Then MsgBox Err.Description, vbCritical, "Error"
End Sub