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

Posted 2022-05-26 笑虾

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

• 方案一 （不喜欢这种）
• 方案二 （勉强）

方案一 （不喜欢这种）

1. 复制工作表，生成一个新工作薄。
2. 获取当前活动工作薄，然后保存。（说实话，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

方案二 （勉强）

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

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