VBA 实例：拆分每个工作表为单个文件

原创已于 2022-06-13 21:21:52 修改 · 1.1k 阅读

6 ·

CC 4.0 BY-SA版权

大家好，我是笨笨，笨笨的笨，笨笨的笨，转载请注明出处，谢谢！

文章标签：

#vba #excel #工作表 #工作薄 #拆分

于 2022-05-24 10:37:53 首次发布

VBA 专栏收录该内容

21 篇文章

订阅专栏

这篇博客介绍了使用VBA在Excel中将每个工作表拆分为单独的.xlsx文件的两种方法。第一种方法涉及复制工作表并保存新工作簿，但作者对这种方式的焦点切换和潜在风险表示不满。第二种方法则是先创建新工作簿，再复制工作表并保存，作者认为这种方法较为稳妥。两种方法的代码实现详细列出，可供VBA学习者参考。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

方案一（不喜欢这种）

复制工作表，生成一个新工作薄。
获取当前活动工作薄，然后保存。（说实话，VBA这种思路很别扭。Copy竟然没返回值。很不喜欢针对活动对象的这种操作思路，会抢焦点，有意外的风险。）

Sub Split2Book()
    Dim xPath As String
    xPath = Application.ActiveWorkbook.Path
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each xWs In ThisWorkbook.Sheets
        xWs.Copy
        Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
        Application.ActiveWorkbook.Close False
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

方案二（勉强）

先创建新工作薄。
再把工作表复制过去。
最后保存工作薄

Sub Split2Book2()
    curPath = Application.ActiveWorkbook.Path

    For Each mySheet In ThisWorkbook.Sheets
        ' 创建一个新工作薄
        Set myBook = Workbooks.Add
        ' 避免新 workbook 中的 sheet 名与要拆分的 sheet 冲突
        myBook.Sheets.Item(1).Name = "一个不可能被用到的sheet名字"
        
        ' 将当前 sheet 复制到新 workbook 的第一个 sheet 之前
        mySheet.Copy myBook.Sheets.Item(1)
        ' 删除第2后所有sheet
        For i = 2 To myBook.Sheets.Count
            myBook.Sheets.Item(i).Delete
        Next
        
        ' 保存新创建的 workbook
        myBook.SaveAs Filename:=curPath & "\" & mySheet.Name & ".xlsx"
        myBook.Close False
    Next
End Sub