VBA代码大全002：如何将工作表批量拆分另存为独立的工作簿？

有时候我们拿到一个excel工作簿，希望将其中所有工作表独立另存为一个个独立的excel工作簿。

如果用手工操作，可以用鼠标右键单击工作表名称标签，在弹出的快捷菜单中选择“移动或者复制”命令，在弹出的“移动或者复制工作表”对话框中可以选择将工作表移动到当前工作簿中的任意一个工作表的位置之前或之后，也可以将工作表移动到一个新的空白工作簿。

在vba中，Worksheet对象的Copy方法可以实现以上的功能。

它的语法如下：

expression . Copy( Before , After )

其中 Before 和After参数表示要插在哪个工作表之前或者之后，如果都不提供的话，则表示移动到一个空白的新的工作簿。
​

基于上述的知识，可以应用下面的vba代码批量将所有excel工作簿中的所有工作表批量另存为独立的excel工作簿：

Sub 工作表批量另存为独立的工作簿()
    'QQ：1722187970，微信:xycgenius,公众号:水星excel
    Dim oWK As Worksheet
    Dim oWB As Workbook
    Dim sPath As String
    Dim sName As String
    If MsgBox("现在开始将把各工作表独立另存为工作簿文件，请再次检查格式数据是否正确？", vbYesNo, "重要提示") = vbYes Then
        '要保存的路径
        sPath = Excel.ThisWorkbook.Path
        '避免保存过程中弹出对话框干扰、公式计算干扰等
        Excel.Application.ScreenUpdating = False
        Excel.Application.Calculation = xlCalculationManual
        Excel.Application.DisplayAlerts = False
        For Each oWK In Excel.ThisWorkbook.Worksheets
            With oWK
                    '将工作表名称作为工作簿的名称保存
                    sName = .Name
                    .Copy
                    Set oWB = Excel.Application.ActiveWorkbook
                    oWB.SaveAs sPath & "\" & .Name, xlOpenXMLWorkbook
                    oWB.Close
            End With
        Next
        Excel.Application.ScreenUpdating = True
        Excel.Application.Calculation = xlCalculationAutomatic
        Excel.Application.DisplayAlerts = True
        MsgBox "操作结束"
    End If
End Sub