【vba】拆分工作簿：自動將一個工作簿中的多個工作表拆分為多個工作簿

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