拆分工作表放入一個文件夾中的工作簿

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