工作常用的EXCEL公式 | 一个工作簿拆分成多个工作簿（VBA）

需求：一个工作簿拆分成多个工作簿

 

 解决方法：VBA代码

-----------------方法1：自选文件夹路径-----------------
Sub EachShtToWorkbook()
Dim sht As Worksheet, strPath As String

With Application.FileDialog(msoFileDialogFolderPicker)
'选择保存工作薄的文件路径，FileDialog-获取目录名称，msoFileDialogFolderPicker选择一个文件夹
If .Show Then strPath = .SelectedItems(1) Else Exit Sub
'如果显示对话框，读取选择的文件路径，如果用户未选取路径则退出程序
End With

If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

Application.DisplayAlerts = False
'取消显示系统警告和消息，避免重名工作簿无法保存。当有重名工作簿时，会直接覆盖保存。
Application.ScreenUpdating = False '取消屏幕刷新

For Each sht In Worksheets '遍历工作表
sht.Copy '复制工作表，工作表单纯复制后，会成为活动工作薄
With ActiveWorkbook
.SaveAs strPath & sht.Name, xlWorkbookDefault
'保存活动工作薄到指定路径下，以当前系统默认文件格式
.Close True '关闭工作薄并保存
End With
Next

MsgBox "处理完成。", , "提醒"

Application.ScreenUpdating = True '恢复屏幕刷新
Application.DisplayAlerts = True '恢复显示系统警告和消息

End Sub

-----------------方法2：固定文件夹路径-----------------

Sub EachShtToWorkbookFixedPath()
Dim sht As Worksheet
Dim strPath As String

' 将文件夹路径硬编码为指定路径
strPath = "C:\Users\hank-02\Desktop\测试\" ' 替换为你要保存的路径（！！！！）

Application.DisplayAlerts = False
Application.ScreenUpdating = False

For Each sht In Worksheets
sht.Copy
With ActiveWorkbook
.SaveAs strPath & sht.Name, xlWorkbookDefault
.Close True
End With
Next

MsgBox "处理完成。", , "提醒"

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub