有时,我们需要将一个工作簿里的每一张工作表,另存为单独的工作薄;如果只是一两张工作表需要这样处理,我们手工操作就挺好的,可如果是若干张,手工操作……岂不是太朴素?
如果使用VBA来处理,这事就简单了。
怎么个简单法呢?,请看动画视频:
动画中所粘贴的代码如下:
Sub Newbooks() 'EH技术论坛。VBA编程学习与实践。看见星光 Dim sht As Worksheet, mypath$ With Application.FileDialog(msoFileDialogFolderPicker) '选择保存工作薄的文件路径 .AllowMultiSelect = False '不允许多选 If .Show Then mypath = .SelectedItems(1) '读取选择的文件路径 Else Exit Sub '如果没有选择保存路径,则退出程序 End If End With If Right(mypath, 1) <> "\" Then mypath = mypath & "\" Application.DisplayAlerts = False '取消显示系统警告和消息,避免重名工作簿无法保存。当有重名工作簿时,会直接覆盖保存。 Application.ScreenUpdating = False '取消屏幕刷新 For Each sht In Worksheets '遍历工作表 sht.Copy '复制工作表,工作表单纯复制后,会成为活动工作薄 With ActiveWorkbook .SaveAs mypath & sht.Name, xlWorkbookDefault '保存活动工作薄到指定路径下,以默认文件格式 .Close True '关闭工作薄并保存 End With Next MsgBox "处理完成。", , "提醒" Application.ScreenUpdating = True '恢复屏幕刷新 Application.DisplayAlerts = True '恢复显示系统警告和消息 End Sub
小贴士:
由于代码取消了系统信息警告(Application.DisplayAlerts = False),当保存文件的路径下有重名工作簿时,该段代码会直接以新文件覆盖旧文件的并保存,但不会发出提醒信息。