另存所有工作表（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 Sheets
    sht.Copy
    ActiveWorkbook.SaveAs ipath & title & "_" & num & "_" & sht.Name & ".xls"   '(工作表名称为文件名）
    num = num + 1
   ActiveWorkbook.Close
Next
Application.ScreenUpdating = True          '恢复屏幕刷新
End Sub