将工作表拆分成一个文件夹中的工作簿。

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