Excel 将工作表拆分为单个文件夹中的工作簿

我试图通过在单个工作簿中分离每个工作表来创建多个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  

---

我在另一个工作簿中使用了相同的代码，它工作正常，但现在看到工作表类的copy方法失败错误

---

有人能解释一下为什么以及如何解决这个问题吗？

为了执行所描述的任务，您的代码有一些复杂之处。我修改了您的代码，使其能够使用活动工作簿中的所有工作表创建单独的工作簿

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

Sub Splitbook（）
Dim CurWb作为工作簿，NewWb作为工作簿
将MyPath设置为字符串
MyPath=ActiveWorkbook.Path
设置CurWb=ActiveWorkbook
Application.ScreenUpdating=False
'循环浏览活动工作簿中的所有工作表
对于CurWb.工作表中的每个CurWs
'将工作表复制到新工作簿
CurWb.Sheets（CurWs.Name）.Copy After:=工作簿.Add.Sheets（1）
设置NewWb=ActiveWorkbook
'删除空工作表，保存工作簿并关闭工作簿
Application.DisplayAlerts=False
对于NewWb.工作表中的每个NewWs
如果是NewWs.Name CurWs.Name，那么是NewWs.Delete
下一个新闻
NewWb.SaveAs文件名：=MyPath&“\”&CurWs.Name&“.xls”，文件格式：=56
NewWb.Close SaveChanges:=False
Application.DisplayAlerts=True
下一个宵禁
Application.ScreenUpdating=True
端接头

我已修改了您的代码，以检查复制的工作表是否可见。请尝试一下，让我知道结果

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

---

我在不同的工作簿中使用了相同的代码，但它起作用了。请通过这个@Soren Holten Hansen和Santosh。谢谢您的指导。