另存所有工作表（sheet）为单独工作簿

Sub 另存所有工作表为工作簿()
Dim sht As Worksheet
Dim num As Integer
Dim title As String
num = 1
title = InputBox("请输入工作簿文件名的开头字符", "拆分工作表为工作簿 ")
Application.ScreenUpdating = False         '禁用屏幕刷新
ipath = ThisWorkbook.Path & "\"
For Each sht In Sheetssht.CopyActiveWorkbook.SaveAs ipath & title & "_" & num & "_" & sht.Name & ".xls"   '(工作表名称为文件名）num = num + 1ActiveWorkbook.Close
Next
Application.ScreenUpdating = True          '恢复屏幕刷新
End Sub