Sub 拆分工作薄()
 Dim xpath As String
 xpath = ActiveWorkbook.Path
 Dim sht As Worksheet
 For Each sht In ActiveWorkbook.Sheets
 sht.Copy
 ActiveWorkbook.SaveAs Filename:=xpath & "\" & sht.Name & ".xlsx" '将文件存放在工作薄所在的位置
 ActiveWorkbook.Close
 Next
 MsgBox "拆分完毕！"
End Sub