|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
試一下
- Sub SaveRangeAsNewWorkbook()
- Dim rng As Range
- Dim newWorkbook As Workbook
- Dim fileName As String
-
- '定义要另存为的文件名为当前日期
- fileName = Format(Date, "yyyy-mm-dd") & ".xlsx"
-
- '检查是否已存在具有相同名称的文件
- If Dir(fileName) <> "" Then
- If MsgBox("该文件已存在。您是否要覆盖该文件?", vbYesNo) = vbNo Then Exit Sub
- End If
-
- '选择要另存为的区域
- Set rng = Application.InputBox("请选择要另存为的区域", "选择区域", Type:=8)
-
- '如果用户取消选择区域,则退出子程序
- If rng Is Nothing Then Exit Sub
-
- '将选定的区域复制到新工作簿中
- rng.Copy
-
- '创建新工作簿并将其保存到指定路径
- Set newWorkbook = Workbooks.Add
- newWorkbook.Sheets(1).Paste
- newWorkbook.SaveAs fileName
- newWorkbook.Close
-
- '清除剪贴板中的内容
- Application.CutCopyMode = False
-
- '显示保存成功的消息
- MsgBox "已将选定区域另存为 " & fileName & "。"
- End Sub
复制代码 |
|