【vba】拆分工作簿：自动将一个工作簿中的多个工作表拆分为多个工作簿

时间：2024-03-10 10:18:12

使用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

 

补充知识点：

VBA中字符换行显示需要使用换行符来完成。下面是常用的换行符
\'chr(10) 可以生成换行符
\'chr(13) 可以生成回车符
\'vbcrlf 换行符和回车符
\'vbCr 等同于chr(10)
赾hr(13)
\'例：
Sub test3()
  MsgBox "我爱" & Chr(10) & "Excel学习"
 \' MsgBox "我爱你" & Chr(13) & "Excel"
 \' MsgBox "今天" & vbCrLf & "我是大王"
End Sub

 

相关文章