如何选择指定区域，另存为新的工作簿？

x2121

我想把 A1:C8 数据用VBA , 另存为：文件名是当前日期的新工作簿，如果存在就提示，谢谢。

liulang0808

可以用dir 或者fso判断指定文件名是否存在
https://club.excelhome.net/threa ... tml?_dsign=73cffde5
当前日期可以用date，具体格式可以使用format处理下

mmwwdd

以下是VBA代码：
Sub SaveAsNewWorkbook()
    Dim wb As Workbook
    Dim newWb As Workbook
    Dim filePath As String
   
    ' 获取当前日期
    Dim currentDate As String
    currentDate = Format(Date, "yyyymmdd")
   
    ' 设置保存路径
    filePath = ThisWorkbook.Path & "\" & currentDate & ".xlsx"
   
    ' 判断文件是否已存在
    If Dir(filePath) <> "" Then
        ' 文件已存在，提示用户是否覆盖
        If MsgBox("文件已存在，是否覆盖？", vbYesNo) = vbNo Then
            Exit Sub
        End If
        ' 关闭已存在的工作簿
        For Each wb In Application.Workbooks
            If wb.FullName = filePath Then
                wb.Close savechanges:=False
                Exit For
            End If
        Next wb
    End If
   
    ' 创建新工作簿
    Set newWb = Workbooks.Add
    ' 将数据复制到新工作簿
    ThisWorkbook.Sheets("Sheet1").Range("A1:C8").Copy newWb.Sheets("Sheet1").Range("A1")
    ' 保存新工作簿
    newWb.SaveAs filePath
    ' 关闭新工作簿
    newWb.Close savechanges:=True
   
    MsgBox "保存成功！"
End Sub

x2121

能有能运行的代码吗？

mmwwdd

x2121 发表于 2023-3-31 11:50
能有能运行的代码吗？

什么意思，这个不能运行吗

x2121

mmwwdd 发表于 2023-3-31 10:47
以下是VBA代码：
Sub SaveAsNewWorkbook()
    Dim wb As Workbook

谢谢，之前没有刷新看不到。可以运行了。

x2121

mmwwdd 发表于 2023-3-31 10:47
以下是VBA代码：
Sub SaveAsNewWorkbook()
    Dim wb As Workbook

我发现如果选定区域的数据是从其他工作表获取的，复制就得不到信息，请问可以怎么解决这个问题？

如下图：

niko88819

試一下

1. Sub SaveRangeAsNewWorkbook()
   
2.     Dim rng As Range
   
3.     Dim newWorkbook As Workbook
   
4.     Dim fileName As String
   
5.    
   
6.     '定义要另存为的文件名为当前日期
   
7.     fileName = Format(Date, "yyyy-mm-dd") & ".xlsx"
   
8.    
   
9.     '检查是否已存在具有相同名称的文件
   
10.     If Dir(fileName) <> "" Then
    
11.         If MsgBox("该文件已存在。您是否要覆盖该文件？", vbYesNo) = vbNo Then Exit Sub
    
12.     End If
    
13.    
    
14.     '选择要另存为的区域
    
15.     Set rng = Application.InputBox("请选择要另存为的区域", "选择区域", Type:=8)
    
16.    
    
17.     '如果用户取消选择区域，则退出子程序
    
18.     If rng Is Nothing Then Exit Sub
    
19.    
    
20.     '将选定的区域复制到新工作簿中
    
21.     rng.Copy
    
22.    
    
23.     '创建新工作簿并将其保存到指定路径
    
24.     Set newWorkbook = Workbooks.Add
    
25.     newWorkbook.Sheets(1).Paste
    
26.     newWorkbook.SaveAs fileName
    
27.     newWorkbook.Close
    
28.    
    
29.     '清除剪贴板中的内容
    
30.     Application.CutCopyMode = False
    
31.    
    
32.     '显示保存成功的消息
    
33.     MsgBox "已将选定区域另存为 " & fileName & "。"
    
34. End Sub
    

复制代码

x2121

niko88819 发表于 2023-4-2 17:50
試一下

还是不行，单元格还是出现#REF!

x2121

niko88819 发表于 2023-4-2 17:50
試一下

这个代码，怎么指定复制的区域？如A1:D12