本文转载自公众号:Excel之家ExcelHome,作者:看见星光。 动画中所粘贴的代码如下: Sub Newbooks() 'ExcelHome技术论坛 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),当保存文件的路径下有重名工作簿时,该段代码会直接以新文件覆盖旧文件的并保存,且不会发出提醒信息。 图文制作:看见星光
|
|