Question

Sub Splitbook()
MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
sht.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\" & sht.Name & ".xlsx"
ActiveWorkbook.Close savechanges:=True
Next sht
End Sub

发出错误

运行时错误1004
工作表类的复制方法失败

如何删除此错误？

Answer 1

Sub Splitbook()
MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
sht.usedrange.copy
set wb= workbooks.add
wb.sheets(1).Paste
application.cutcopymode=false
wb.saveas(filename:=MyPath & "_" & sht.Name & ".xlsx",xlopenXMLworkbook)
wb.close
Next sht
End Sub

尝试这个子程序，这可能会起作用。我没有测试过代码。如果有任何错误，请原谅我。

Answer 2

使用对象测试代码以正确处理副本：

Sub Splitbook()
Dim MyPath As String
Dim ShT As Worksheet
Dim NewWB As Workbook
Dim NewSHT As Worksheet
    MyPath = ThisWorkbook.Path
    For Each ShT In ThisWorkbook.Sheets
        ShT.Copy
        Set NewWB = ActiveWorkbook
        With NewWB
            With .Sheets(1)
                With .Cells
                .Copy
                .PasteSpecial Paste:=xlPasteValues
                .PasteSpecial Paste:=xlPasteFormats
                End With '.Cells
            End With '.Sheets(1)
            .SaveAs FileName:=MyPath & "\" & ShT.Name & ".xlsx"
            .Close savechanges:=True
        End With 'NewWB
    Next ShT
End Sub

将Excel表格从一个Excel文件拆分为多个Excel文件

2 个答案: