最近在工作中遇到一个小需求,将excel 中多个sheet 拆分为一个个单独的excel。

网上也有许多的在线工具给我们使用。但是当excel 过大或者sheet太多在线工具就可能存在问题。

这次我们就使用excel 自带的开发者工具直接拆分,只要你能够打开excel 就可以拆分。

打开EXCEL 找到 【开发工具】 点击 【查看代码】

如果没有找到【开发工具】,点击【文件】找到【选项】按钮,在后面的弹窗,找到【自定义功能区】勾选上【开发工具】就可以在菜单上显示了

在点击【查看代码】后在弹出的页面上,选择【插入】选择【模块】,点击下方的模块1,输入相应的代码。点击【运行】


Sub 分拆工作表()
    Dim sht As Worksheet
    Dim MyBook As Workbook
    Dim newBook As Workbook
    Dim filePath As String
    
    ' 设置引用到当前工作簿
    Set MyBook = ActiveWorkbook
    filePath = MyBook.Path
    
    ' 检查路径是否有效
    If filePath = "" Then
        MsgBox "请先保存工作簿!", vbExclamation, "错误"
        Exit Sub
    End If
    
    ' 遍历所有工作表
    For Each sht In MyBook.Sheets
        ' 复制工作表到新工作簿
        sht.Copy
        Set newBook = ActiveWorkbook
        
        ' 保存新工作簿
        On Error Resume Next ' 避免文件已存在时报错
        newBook.SaveAs Filename:=filePath & "\" & sht.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        On Error GoTo 0
        
        ' 关闭新工作簿
        newBook.Close SaveChanges:=False
    Next sht
    
    ' 显示完成消息
    MsgBox "文件已经被分拆完毕!", vbInformation, "完成"
End Sub