VBA代码：拆分工作簿示例——将工作簿中的每个工作表保存为单独的工作簿

excelperfect

标签：VBA

有时候，我们想将工作簿中的每个工作表都保存为一个单独的工作簿。

你可以使用下面的操作逐个保存工作表：

1.在工作表标签中单击右键。

2.选取“移动或复制…”命令。

3.选择“(新工作簿)”。

4.保存该工作簿。

图1

这样，有多少工作表，你就要操作上面的步骤多少次。

然而，如果存在很多个工作簿，这样的重复工作使用VBA是最合适的。下面是代码：

Sub SaveWorksheetsToWorkbook()

    Dim wks As Worksheet

    Dim strPath As String

    Dim strFileName As String

    Dim strExtension As String

    Dim lngFileFormatCode As Long

    Dim arr

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    With Application.FileDialog(msoFileDialogFolderPicker)

        .InitialFileName =Application.DefaultFilePath & '\'

        .Title = '选择保存工作表的位置'

        .Show

        If .SelectedItems.Count = 0 Then

            MsgBox '取消'

            Exit Sub

        Else

            strPath = .SelectedItems(1) &'\'

        End If

    End With

    arr = Split(ThisWorkbook.FullName,'.')

    strExtension = arr(UBound(arr))

    Select Case strExtension

        Case 'xlsb':lngFileFormatCode = 50

        Case 'xlsx':lngFileFormatCode = 51

        Case 'xlsm':lngFileFormatCode = 52

        Case 'xls': lngFileFormatCode= 56

    End Select

    For Each wks In Worksheets

        strFileName = strPath & wks.Name& '.' & strExtension

        wks.Copy

        ActiveWorkbook.SaveAsFilename:=strFileName, FileFormat:=lngFileFormatCode

        ActiveWorkbook.Close

    Next wks

    Application.ScreenUpdating = True

    Application.DisplayAlerts = True

End Sub

只需在要拆分的工作簿中运行上述代码，就可将该工作簿中的所有工作表全部保存为单独的工作簿。

欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。

欢迎到知识星球：完美Excel社群，进行技术交流和提问，获取更多电子资料，并通过社群加入专门的微信讨论群，更方便交流。