Help With Save All Sheets Except First VBA Code

[camskolnick]

Hello everyone,

I am relatively new to VBA Programming and have been teaching myself through various forums. I wrote the code below which should save each sheet in a workbook as a separate workbook, excluding the first sheet. It seems to work, however, when one of my colleagues attempted to run the code on a workbook with ~200 sheets, it looks like it only saved 64 of the 200. Can someone let me know if there is any issue with my code? I've looked through it a few times to no avail, or is it possible that this was a case of user error?

Thanks guys! Please see the code below:



Sub Save_Sheets()
Dim i As Integer
Dim numSht As Integer
Dim ws As Worksheet
Dim fileName As String
Application.DisplayAlerts = False
fileName = Sheets(1).Cells(1, 11)
i = 2
numSht = ThisWorkbook.Worksheets.Count
Do Until i > numSht
Sheets(i).Copy
wb_name = Sheets(1).Name
If Right(fileName, 1) = "\" Then
ActiveWorkbook.SaveAs fileName:=Excel.Workbooks(fileName).Worksheets("Testing").Cells(3, 7).Value & _
Format(Date, "mm-dd-yy") & " - " & wb_name & " - Statement of Accounts.xlsx", FileFormat:=51
Else
ActiveWorkbook.SaveAs fileName:=Excel.Workbooks(fileName).Worksheets("Testing").Cells(3, 7).Value & "\" & _
Format(Date, "mm-dd-yy") & " - " & wb_name & " - Statement of Accounts.xlsx", FileFormat:=51
End If
ActiveWorkbook.Close
i = i + 1
Loop
Application.DisplayAlerts = True
End Sub

[Paul_Hossler]

Can you make a specific example with data?

It looks like you get fileName from ThisWorkbook


fileName = Sheets(1).Cells(1, 11)

and then

use that as the name of a WB with WS Testing (3,7) to construct a file name to save


Excel.Workbooks(fileName).Worksheets("Testing").Cells(3, 7).Value

[camskolnick]

Hi Paul,

Yes that is correct I forgot to mentioned that in my post. I am getting the fileName from cell 1, 11 as you had mentioned and I can confirm that there is not an issue with this portion of the code as it does seem to work whenever I use it to save ~50 sheets at a time. The issue only seems to arise when there is >64 total sheets in the workbook, in which case it seems to only save 64 of them.

Thanks again!

[Paul_Hossler]

I'm guessing that you're running out of resources which is why I asked for SPECIFIC examples

Attach a slimmed down simplified WB so we can take a look (not much data and 3-4 sheets)

[Aussiebear]

Large workbooks with greater than 64 sheets..... a User is certainly asking for a miracle or two in dealing with workbooks that big.

[p45cal]

Any hidden sheet will cause the code to complain.

[Paul_Hossler]

The last time I did something like this I didn't have that many sheets

1. I've found that when dealing with multiple workbooks, it's a good idea to be very explicit and not rely on ActiveWorkbook and ActiveSheet

2. Something like " Sheets(1). " is the first sheet in the tabs:

31223

Immediate Window:

?sheets(1).name
Sheet6

so I'd go with a code name or something like Worksheets("Master")




Option Explicit

Sub Save_Sheets()
Dim i As Long
Dim wb1 As Workbook, wb2 As Workbook

Dim ws As Worksheet, ws1 As Worksheet
Dim fileName As String, s As String

Set wb1 = ThisWorkbook

fileName = wb1.Path & Application.PathSeparator & wb1.Sheets(1).Cells(1, 11) & " - "

If Right(fileName, 1) = "\" Then fileName = Left(fileName, Len(fileName) - 1)

Application.ScreenUpdating = False

For i = 2 To wb1.Worksheets.Count

Set ws1 = wb1.Worksheets(i)

If ws1.Visible <> xlSheetVisible Then GoTo Next_WS

ws1.Copy

Set wb2 = ActiveWorkbook

s = fileName & Format(Date, "mm-dd-yy") & " - " & ws1.Name & " - Statement of Accounts.xlsx"

Debug.Print s

Application.StatusBar = s

On Error Resume Next
Application.DisplayAlerts = False
Kill s
Application.DisplayAlerts = True
On Error GoTo 0


wb2.SaveAs fileName:=s, FileFormat:=51

wb2.Close

wb1.Activate

Next_WS:
Next i

Application.ScreenUpdating = True
Application.StatusBar = False




MsgBox "Done"

End Sub

[jolivanes]

On my speed challenged old laptop, this saved 350 sheets as workbooks in 2 1/2 minutes.
Change references where required if you want to try it.



Dim pth As String, strSaveName As String, i As Long
Dim t
t = Timer
Application.ScreenUpdating = False
pth = "C:\AAAA_Folder\" '<---- Change required
For i = 2 To ThisWorkbook.Worksheets.Count '<---- Change required
strSaveName = pth & "Nov 22 " & Sheets(i).Range("A1").Value & ".xlsx" '<---- Change required, .xlsm for macro enabled
Sheets(i).Copy '<---- Change required
With ActiveWorkbook
Application.DisplayAlerts = False
.SaveAs Filename:=strSaveName, FileFormat:=51 '<---- Possible Change required, 52 for macro enabled
Application.DisplayAlerts = True
.Close
End With
Next i
Application.ScreenUpdating = True
MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to run."
End Sub