最近在工作中遇到一个小需求,将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


