each WorksheetSizes

[Seesee]

Hi,
Appear the error message : "1004 cannot copy the sheet" when run the below vba coding, please help to fix.

Sub WorksheetSizes()
Dim wks As Worksheet
Dim c As Range
Dim sFullFile As String
Dim sReport As String
Dim sWBName As String
sReport = "Size Report"
sWBName = "Erase Me.xls"
sFullFile = ThisWorkbook.path & _
Application.PathSeparator & sWBName
' Add new worksheet to record sizes
On Error Resume Next
Set wks = Worksheets(sReport)
If wks Is Nothing Then
With ThisWorkbook.Worksheets.Add(Before:=Worksheets(1))
.Name = sReport
.Range("A1").Value = "Worksheet Name"
.Range("B1").Value = "Approximate Size (kb)"
End With
End If
On Error GoTo 0
With ThisWorkbook.Worksheets(sReport)
.Select
.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
Set c = .Range("A2")
End With
Application.ScreenUpdating = False
' Loop through worksheets
For Each wks In ActiveWorkbook.Worksheets
If wks.Name <> sReport Then
wks.Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs sFullFile
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
c.Offset(0, 0).Value = wks.Name
c.Offset(0, 1).Value = Format(FileLen(sFullFile) / 1000, "#,##0.00")
Set c = c.Offset(1, 0)
Kill sFullFile
End If
Next wks
Range("a1:b1").WrapText = True
Application.ScreenUpdating = True
End Sub

 

[Michael M]

Use the xl2bb download to upload you data
See .my tag

 

[Michael M]

OR upload your workbook to a hosting site, Dropbox for instance, and then post the link to that file back here.

 

[Seesee]

Hi Michael,

Please find the link and thank you for your great help.

test sample.xlsm

Shared with Dropbox

www.dropbox.com

 

[Michael M]

I don't have a problem running the code.
Also, make sure the workbook is not protected !

 

[Seesee]

I don't have a problem running the code.
Also, make sure the workbook is not protected !

Hi Michael,
Thanks again.