【Excel VBA】批量将工作表转换为独立工作簿

论坛 期权论坛 期权     
VBA编程学习与实践   2019-6-9 21:26   7338   0



有时候 有时候 我会相信一切有尽头……
相聚离开都有时候 没有什么会永垂不朽……
有时,我们需要将一个工作簿里的每一张工作表,另存为单独的工作薄;如果只是一两张工作表,我们手工操作就挺好的,可如果是若干张,手工操作……岂不是太……素颜?
咳,美颜相机了解一下——如果使用VBA来处理,这事儿就简单了。
怎么个简单法呢?,请看动画视频:


动画中所粘贴的代码如下:
Sub Newbooks()    'EH技术论坛。VBA编程学习与实践。看见星光    Dim sht As Worksheet, strPath$    With Application.FileDialog(msoFileDialogFolderPicker)   '选择保存工作薄的文件路径        If .Show Then            strPath = .SelectedItems(1)            '读取选择的文件路径        Else            Exit Sub            '如果没有选择保存路径,则退出程序        End If    End With    If Right(strPath, 1)  "\" Then strPath = strPath & "\"    Application.DisplayAlerts = False    '取消显示系统警告和消息,避免重名工作簿无法保存。当有重名工作簿时,会直接覆盖保存。    Application.ScreenUpdating = False    '取消屏幕刷新    For Each sht In Worksheets    '遍历工作表        sht.Copy        '复制工作表,工作表单纯复制后,会成为活动工作薄        With ActiveWorkbook            .SaveAs strPath & sht.Name, xlWorkbookDefault            '保存活动工作薄到指定路径下,以默认文件格式            .Close True '关闭工作薄并保存        End With    Next    Application.ScreenUpdating = True '恢复屏幕刷新    Application.DisplayAlerts = True '恢复显示系统警告和消息    MsgBox "处理完成。", , "提醒"End Sub
小贴士:
由于代码取消了系统信息警告(Application.DisplayAlerts = False),当保存文件的路径下有重名工作簿时,该段代码会直接用新文件覆盖旧文件,不会发出提醒信息哦。
安,夜夜夜夜夜夜~




一码不扫,
何以扫天下?

ExcelHome
VBA编程学习与实践


分享到 :
0 人收藏
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

积分:220
帖子:44
精华:0
期权论坛 期权论坛
发布
内容

下载期权论坛手机APP