无需VBA实现Excel工作表导出至独立工作簿及VBA导出提速方案

嘿，我来帮你搞定这个问题！你的VBA代码运行慢主要是没做性能优化，同时我也整理了不用VBA的批量导出方法，两种方案都给你详细说清楚：

一、优化现有VBA代码提升速度 #

你的原代码之所以慢，核心原因是没关闭Excel的界面刷新、事件触发等后台冗余操作，而且两次PasteSpecial的剪贴板交互也拖慢了速度。下面是优化后的代码，能大幅提升运行效率：

Sub Splitbook()
    Dim MyPath As String
    Dim sht As Worksheet
    Dim newWB As Workbook
    
    ' 关闭后台冗余操作，相当于干活时关掉不必要的弹窗和动画
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    MyPath = ThisWorkbook.Path
    ' 确保路径末尾有反斜杠，避免保存时出错
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    
    For Each sht In ThisWorkbook.Sheets
        ' 复制工作表到新工作簿，直接获取新工作簿对象，不用依赖不稳定的ActiveSheet
        sht.Copy
        Set newWB = ActiveWorkbook
        
        With newWB.Sheets(1).UsedRange
            ' 一次性处理值和格式，减少剪贴板交互
            .Copy
            .PasteSpecial Paste:=xlPasteValuesAndNumberFormats ' 保留值和数字格式
            .PasteSpecial Paste:=xlPasteFormats ' 保留单元格样式、填充色等格式
            Application.CutCopyMode = False ' 清空剪贴板，释放资源
        End With
        
        ' 保存并关闭新工作簿
        newWB.SaveAs Filename:=MyPath & "XXX" & sht.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        newWB.Close SaveChanges:=False
        Set newWB = Nothing ' 释放内存
    Next sht
    
    ' 恢复Excel默认设置，不影响后续操作
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    
    MsgBox "导出完成！", vbInformation
End Sub

关键优化点： #

• 关闭ScreenUpdating等后台操作：避免Excel每一步都刷新界面、弹提示，直接把运行速度拉满
• 用对象引用代替ActiveSheet：减少Excel的“查找”时间，同时避免操作出错
• 合并格式粘贴操作：减少剪贴板的读写次数，降低资源消耗
• 规范路径格式：避免因路径格式错误导致的保存失败

二、无需VBA的批量导出方案 #

如果不想碰VBA，这里有两种实用的批量导出方法：

方法1：手动高效版（利用「移动或复制」批量操作） #

这个方法适合工作表数量不算特别多的场景，操作简单：

1. 批量选工作表：按住Ctrl键点击底部工作表标签，选中所有要导出的表；如果要选连续的表，用Shift键就行；表太多的话，右键标签选「选定全部工作表」再取消不需要的
2. 复制到新工作簿：右键选中的标签，选「移动或复制」，在弹窗里「工作簿」下拉选「新工作簿」，勾选「建立副本」，点击确定
3. 单独保存每个表：在新生成的工作簿里，右键单个工作表标签，再次选「移动或复制」→「新工作簿」+「建立副本」，然后保存这个新工作簿；或者用「另存为」时，点击「工具」→「常规选项」，选择「保存活动工作表」（部分版本在保存界面的「选项」里）

方法2：Power Query全自动版 #

Power Query可以实现无代码全自动批量导出，步骤如下：

1. 打开源工作簿，点击「数据」→「获取数据」→「自文件」→「自工作簿」，选择当前工作簿
2. 在「导航器」窗口勾选「选择多项」，选中所有要导出的工作表，点击「转换数据」
3. 在Power Query编辑器里，点击「主页」→「关闭并上载至」→「仅创建连接」，确定
4. 创建空白查询：点击「数据」→「获取数据」→「空白查询」，在编辑器里输入以下M代码（记得修改路径前缀和筛选规则）：

   let
       Source = Excel.CurrentWorkbook(),
       ' 可选：筛选要导出的工作表，比如只导出以"销售"开头的表，删掉这行就导出所有表
       SheetNames = List.Select(Source[Name], each Text.StartsWith(_, "销售")),
       ExportSheets = List.Transform(SheetNames, (sheet) =>
           let
               GetSheetData = Excel.Workbook(File.Contents(ThisWorkbook.Path & "\" & ThisWorkbook.Name)){[Item=sheet,Kind="Sheet"]}[Data],
               SaveFile = Excel.SaveAs(GetSheetData, ThisWorkbook.Path & "\XXX" & sheet & ".xlsx")
           in
               SaveFile
       )
   in
       ExportSheets
   

5. 运行查询：点击「主页」→「关闭并上载」，Power Query就会自动把每个工作表导出成单独的xlsx文件

注意：部分Excel版本的Power Query导出功能需要启用Office脚本权限，如果遇到问题，方法1是更通用的替代方案。

内容的提问来源于stack exchange，提问作者user9530648