Копирование листов в отдельных файлах

Question

Я пытаюсь разбить листы на несколько файлов. Я использовал код ниже без проблем. Тогда сегодня он просто перестал работать с ошибкой во время выполнения - ошибка копирования класса рабочего листа метода.

Sub Splitbook()
'Updateby20140612
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For Each xWs In ThisWorkbook.Sheets
    xWs.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Код ниже работал!

Sub Splitbook()

Dim varResponse As Variant

varResponse = MsgBox("Each new worksheet will be saved as a new file within the current folder. Would you like to create new files using each worksheet now?", vbYesNo, "Selection")
If varResponse <> vbYes Then Exit Sub

'Updateby20140612
Dim xPath As String
Dim wb As Workbook

Set wb = ActiveWorkbook

xPath = Application.ActiveWorkbook.path
Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each xWs In ThisWorkbook.Sheets
    Set newbook = Workbooks.Add
    xWs.Copy before:=newbook.Sheets(1)
    newbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    newbook.Close False
    Set newbook = Nothing
Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "New workbooks successfully created."
End Sub

Answer 1

Должно быть что-то вроде этого (не проверено):

For Each xWs In ThisWorkbook.Sheets
    set newBook = workbooks.add
    xWs.Copy before:=newBook.sheets(1)
    newBook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    newBook.Close False
    set newBook = Nothing
Next xWs