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
工作表类的复制方法失败
如何删除此错误?
答案 0 :(得分:0)
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
尝试这个子程序,这可能会起作用。我没有测试过代码。如果有任何错误,请原谅我。
答案 1 :(得分:0)
使用对象测试代码以正确处理副本:
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