使用vba,将一个工作簿中的多个工作表拆分为多个工作簿,拆分后的工作簿以工作表名称命名,存档在【当前工作簿目录】下的【拆分工作簿】目录下面。 增加逻辑: 1、如果有隐藏工作表时,弹出输入框,选择是否执行及显示当前隐藏的工作表。 Sub 自动拆分工作表到同一目录中() ' ' 自动拆分工作表 宏 ' ' 快捷键: Ctrl+m ' '把各个工作表以单独的工作簿文件保存在本工作簿所在的文件夹下的“拆分工作簿”文件夹下 '获取活动工作簿所在路径 并判断该路径下是否存在文件夹'拆分工作簿',如果不存在则创建 '遍历活动工作簿中的每个工作表,复制并另存为新的工作簿,工作簿文件名以工作表名称命名 '如果遇到隐藏工作表,则先打开隐藏,复制并另存为后关闭隐藏 ' Application.ScreenUpdating = False '关闭屏幕更新 Dim xpath,isNext As String Dim sht As Worksheet xpath = Application.ActiveWorkbook.Path & '\拆分工作簿' If Len(Dir(xpath, vbDirectory)) = 0 Then MkDir xpath '如果文件夹不存在,则新建文件夹 For Each sht In Worksheets If sht.Visible = False Then 'MsgBox '有隐藏工作表' & sht.Name '隐藏工作表是否拆分 isNext = InputBox('1:跳过不处理' & Chr(10) & '2:处理并保持隐藏' & Chr(10) & '3:处理并取消隐藏' & Chr(10) & '空:不输入或其他值则默认不执行', '【' & sht.Name & '】为隐藏工作表,请选择执行方式') If isNext = 2 Or isNext = 3 Then sht.Visible = True '取消工作表的隐藏 sht.Copy ActiveWorkbook.SaveAs FileName:=xpath & '\' & sht.Name & '.xlsx' ActiveWorkbook.Close If isNext = 2 Then sht.Visible = False '恢复工作表的隐藏 End If End If ElseIf sht.Visible = True Then sht.Copy ActiveWorkbook.SaveAs FileName:=xpath & '\' & sht.Name & '.xlsx' ActiveWorkbook.Close End If Next 'MsgBox '工作簿拆分结束' Application.ScreenUpdating = True '恢复屏幕更新 End Sub 补充知识点: |
|
来自: Excel实用知识 > 《VBA与EXCEL》