Private Sub 分拆工作表()
Application.ScreenUpdating = True '让屏幕显示操作过程，
Dim sht As Worksheet
Dim MyBook As Workbook
Set MyBook = ActiveWorkbook
For Each sht In MyBook.Sheets
If sht.Visible = True Then '隐藏的sheet跳过，否则会报1004无法复制错误
sht.Copy
ActiveWorkbook.SaveAs Filename:=MyBook.Path & "\" & sht.Name & "-" & sht.Cells(1, 1) & ".xlsx", FileFormat:=xlWorkbookDefault '将工作簿另存为EXCEL默认格式
ActiveWorkbook.Close
End If
Next
MsgBox "文件已经被分拆完毕!"
Application.ScreenUpdating = True '让屏幕恢复显示操作过程，
End Sub

说明：这一句是用于文件命名
ActiveWorkbook.SaveAs Filename:=MyBook.Path & “” & sht.Name & “-” & sht.Cells(1, 1) & “.xlsx”, FileFormat:=xlWorkbookDefault