Excel如何新建文件并命名

梵蒂冈2022

更新
---------------------------------------------------------
麻烦更新一下程序，能否自动覆盖已经生成的文件，
也就是先将生成的文件删除，然后生成新的，谢谢

--------------------------------------------------------
麻烦帮忙编写一下程序，万分感谢

做了个文件样式，其实 资料名字 里很多东西，

点一下按钮，新建一个excel文件并且叫作“资料清单”，并将当前excel中一个名叫“输出表”中的复制到新建文件中去

1、“输出表”的Excel sheet号是不固定的
2、“输出表”中有些数字来源是用公式编写的
谢谢












补充内容 (2024-6-5 15:43):
新需求在 23楼，谢谢

ykcbf1100

你不准备上传一个附件吗？

梵蒂冈2022

ykcbf1100 发表于 2024-3-31 09:46
你不准备上传一个附件吗？

已发，谢谢

ykcbf1100

梵蒂冈2022 发表于 2024-3-31 09:56
已发，谢谢

新生成的文件中还要带公式吗？

梵蒂冈2022

ykcbf1100 发表于 2024-3-31 09:59
新生成的文件中还要带公式吗？

不需要，纯数字和文字，谢谢

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.31
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     p = ThisWorkbook.Path & ""
   
5.     fn = "资料清单"
   
6.     Set sh = ThisWorkbook.Sheets("输出表")
   
7.     sh.Copy
   
8.     Set wb = ActiveWorkbook
   
9.     With wb.Sheets(1)
   
10.         .Name = sh.Name
    
11.         .UsedRange.Value = .UsedRange.Value
    
12.     End With
    
13.     wb.SaveAs p & fn
    
14.     wb.Close 1
    
15.     Application.ScreenUpdating = True
    
16.     MsgBox "OK！"
    
17. End Sub
    

复制代码

baofa2

1. Sub test1()
   
2.   Dim Conn As Object, p As String, f As String
   
3.   p = ThisWorkbook.Path & "\"
   
4.   Set Conn = CreateObject("ADODB.Connection")
   
5.   Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 XML;Data Source=" & ThisWorkbook.FullName
   
6.   f = p & "资料清单.xlsx"
   
7.   If Dir(f) <> "" Then Kill f
   
8.   Conn.Execute "SELECT * INTO [" & f & "].[输出表] FROM [输出表$]"
   
9.   Conn.Close
   
10.   Set Conn = Nothing
    
11.   Beep
    
12. End Sub

复制代码

梵蒂冈2022

ykcbf1100 发表于 2024-3-31 10:09
附件供参考。。。

大神啊，膜拜一下，是我要的效果

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar
   
    Application.DisplayAlerts = False
    ar = Sheets("输出表").[A1].CurrentRegion.Value
    With Workbooks.Add
        .Sheets(1).[A1].Resize(UBound(ar), UBound(ar, 2)) = ar
        .SaveAs ThisWorkbook.Path & "\资料清单"
        .Close
    End With
    Application.DisplayAlerts = True
   
    Beep
End Sub