Reputation: 31
I have a code that is splitting one workbook into just shy of 500. This code runs from one workbook and opens another to split. On my computer this works every time with no fail. On others the code will 1st stop at the ws.copy line. They stop the code and start again. The code will then work for the first 180-220 sheets then pop the 'SaveAs" error. I thought, based on online reading, that this was a memory problem or a timing error. To fix this, I added a .wait function to no avail. Any help would be greatly appreciated! Code below for reference.
Sub Splitbook()
Dim MyFile As String
MyFile = Sheets("Steps").Range("C6")
Windows(MyFile).Activate
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Sheets
ws.Copy
Name = ws.Range("C15").Value
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & Name & ".xlsx"
Application.ActiveWorkbook.Close False
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ActiveWorkbook.Close SaveChanges:=False
MsgBox ("Split Complete. Press Ok to finish."), vbOKOnly, ("Thank you for your Patience.")
End Sub
EDIT
Based on your feedback I have updated the code as follows:
Sub Splitbook()
Dim MyFile As String
Dim wb As Workbook
MyFile = Sheets("Steps").Range("C6")
Set wb = Application.Workbooks(MyFile)
Windows(MyFile).Activate
Dim Loc As String
Loc = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In wb.Sheets
ws.Copy
Name = ws.Range("C15").Value
Application.ActiveWorkbook.SaveAs Filename:=Loc & "\" & Name & ".xlsx"
DoEvents
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
wb.Close SaveChanges:=False
MsgBox ("Split Complete. Press Ok to finish."), vbOKOnly, ("Thank you for your Patience.")
End Sub
Upvotes: 0
Views: 235
Reputation: 1886
Thus the dangers of ActiveWorkbook
, Activate
, Select
and ActiveSheet
. They may not be what you expect and it matters where the code is located. If you are running from a Module
, Sheet
or ThisWorkbook
also makes a difference. If you are going to run from a module, you will need to qualify the locations - which Workbook
, Sheet
or Range
you are referencing. When you create the new workbook by copying the sheet without a destination, that will be the active workbook for awhile, meanwhile you need to anchor to your starting file.
Sub Splitbook()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Dim OrigWb As Workbook
Set OrigWb = ThisWorkbook 'or Set OrigWb = Workbooks("SplitFile") or some filename if not ThisWorkbook
Dim xPath As String
xPath = OrigWb.Path
For Each ws In OrigWb.Sheets
NewFileName = ws.Range("C15").Value
ws.Copy
With ActiveWorkbook
.SaveAs Filename:=xPath & "\" & NewFileName & ".xlsx"
.Close False
End With
MsgBox ("Split Complete. Press Ok to finish."), vbOKOnly, ("Thank you for your Patience.")
Next ws
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
This works and will work unless Range("C15")
is blank or invalid. The file will not save and you will not know because you turned off alerts. You may want to check that the range is not empty first.
If Not IsEmpty(ws.Range("C15").Value Then
Upvotes: 2