【Office】【VBA宏】使用宏实现表格中sheet表拆分成独立的文件

提示：文章写完后，目录可以自动生成，如何生成可参考右边的帮助文档

---

需求概述

提示：前面根据某一列作为拆分依旧，将表格分类拆分成一个一个的sheet表，然而实际使用中还要将单个的sheet表拆分成独立文件。

---

提示：以下是本篇文章正文内容，下面案例可供参考

一、实现流程

1. 由于要拆分的数据量可能会比较大考虑性能问题（关闭屏幕更新提高性能）.
2. 要求选择一个文件夹作为拆分后存放文件的路径。
3. 循环遍历每个工作表进行保存。
4. 显示一个消息框来通操作已完成。

二、具体代码

代码如下（示例）：

Sub SplitWorkbookToIndividualSheets()  
    Dim wb As Workbook  
    Dim ws As Worksheet  
    Dim targetFolder As String  
    Dim fileName As String  
    Dim i As Integer  
      
    ' 设置当前工作簿为源工作簿  
    Set wb = ThisWorkbook  
      
    ' 使用FileDialog选择一个文件夹  
    With Application.FileDialog(msoFileDialogFolderPicker)  
        .Show  
        If .SelectedItems.Count = 0 Then  
            MsgBox "请选择一个文件夹"  
            Exit Sub  
        End If  
        targetFolder = .SelectedItems(1) & "\"  
    End With  
      
    ' 循环遍历每个工作表  
    Application.ScreenUpdating = False ' 关闭屏幕更新以加速过程  
    For Each ws In wb.Sheets  
        ' 构建文件名  
        fileName = targetFolder & ws.Name & ".xlsx"  
        ' 检查文件是否已存在  
        i = 1  
        While FileExists(fileName)  
            fileName = targetFolder & ws.Name & " (" & i & ").xlsx"  
            i = i + 1  
        Wend  
        ' 将工作表复制到新工作簿并保存  
        ws.Copy  
        With ActiveWorkbook  
            .SaveAs fileName:=fileName, FileFormat:=xlOpenXMLWorkbook ' 保存为.xlsx格式  
            .Close SaveChanges:=False ' 关闭新工作簿而不保存更改  
        End With  
    Next ws  
    Application.ScreenUpdating = True ' 恢复屏幕更新  
    MsgBox "拆分完成！"  
End Sub  
  
' 辅助函数：检查文件是否存在  
Function FileExists(filePath As String) As Boolean  
    Dim fso As Object  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    FileExists = fso.FileExists(filePath)  
End Function

---

使用方法

1. 打开Excel并加载包含要拆分数据的工作簿。
2. 按Alt + F11打开VBA编辑器。
3. 在项目浏览器中，右键点击你的工作簿名称，选择“插入” -> “模块”。
4. 在新打开的模块窗口中，粘贴上述代码。
5. 按F5运行SplitWorkbookToIndividualSheets宏。
6. 根据提示框选择拆分出的文件存放路径。
7. 等待宏运行完成。

注意事项

在运行宏之前，请确保备份你的数据，以防万一出现意外情况。

小结

到此，所有分享结束了，希望代码可以帮助你们。还有更多功能和方法值得我和你们去研究，感谢浏览。有其他好的问题和经验可以在评论区留言或私信我。