前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >VBA代码:拆分工作簿示例——将工作簿中的每个工作表保存为单独的工作簿

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

作者头像
fanjy
发布2022-06-04 09:59:45
3.9K0
发布2022-06-04 09:59:45
举报
文章被收录于专栏:完美Excel

标签:VBA

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

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

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

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

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

4.保存该工作簿。

图1

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

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

代码语言:javascript
复制
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

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

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

本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2022-05-11,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 完美Excel 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体同步曝光计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档