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

最新推荐文章于 2025-04-30 14:40:52 发布

键盘上的小怪兽G

最新推荐文章于 2025-04-30 14:40:52 发布

阅读量267

点赞数

文章标签： excel

本文链接：https://blog.csdn.net/sforce/article/details/120010403

版权

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