对象“_Workbook”的方法“SaveAs”在其他计算机上失败

Question

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

Answer 1

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