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

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

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

 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 

Answer 2

 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 

试试这个子例程，这可能工作。 我没有testing过的代码。 请原谅我是否有任何错误。