Сплит листов в рабочих книгах в одной папке

Question

Я пытаюсь создать несколько рабочих книг Excel, отделяя каждую таблицу в одну книгу с:

Sub Splitbook() 
MyPath = ThisWorkbook.Path 
For Each sht In ThisWorkbook.Sheets 
sht.Copy 
'(I got an error here-copy method of worksheet class failed) 
ActiveSheet.Cells.Copy 
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues 
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats 
ActiveWorkbook.SaveAs _ 
Filename:=MyPath & "\" & sht.Name & ".xls" 
ActiveWorkbook.Close savechanges:=False 
Next sht 
End Sub 

Я использовал тот же код для другой книги, и она работала но теперь я вижу, что метод копирования класса рабочего листа не прошел ошибку.

Может кто-нибудь объяснить, почему и как исправить это, пожалуйста?

Answer 1

Для выполнения описанной задачи существует несколько осложнений с вашим кодом. Я изменил код, чтобы создать отдельные рабочие книги из всех рабочих листов в вашей активной книге.

Sub Splitbook() 
    Dim CurWb As Workbook, NewWb As Workbook 
    Dim MyPath As String 
    MyPath = ActiveWorkbook.Path 
    Set CurWb = ActiveWorkbook 

    Application.ScreenUpdating = False 

    'Loops through all sheets in active workbook 
    For Each CurWs In CurWb.Worksheets 
     'Copy sheet to new workbook 
     CurWb.Sheets(CurWs.Name).Copy After:=Workbooks.Add.Sheets(1) 
     Set NewWb = ActiveWorkbook 

     'Removes empty sheets, saves workbook and closes workbook 
     Application.DisplayAlerts = False 
     For Each NewWs In NewWb.Worksheets 
      If NewWs.Name <> CurWs.Name Then NewWs.Delete 
     Next NewWs 
     NewWb.SaveAs Filename:=MyPath & "\" & CurWs.Name & ".xls", FileFormat:=56 
     NewWb.Close SaveChanges:=False 
     Application.DisplayAlerts = True 
    Next CurWs 

    Application.ScreenUpdating = True 
End Sub 

Answer 2

Я изменил ваш код, чтобы проверить, что скопированный лист виден. Пожалуйста, попробуйте и дайте мне знать результаты.

Sub Splitbook() 
    MyPath = ThisWorkbook.Path 
    For Each sht In ThisWorkbook.Sheets 

     If sht.Visible = True Then 
      sht.Copy 
      '(I got an error here-copy method of worksheet class failed) 
      ActiveSheet.Cells.Copy 
      ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues 
      ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats 
      ActiveWorkbook.SaveAs _ 
        Filename:=MyPath & "\" & sht.Name & ".xls" 
      ActiveWorkbook.Close savechanges:=False 
     End If 
    Next sht 
End Sub