求老师帮我写一个另存工作簿的VBA代码

秋先森℡

将“入库单”表格，以“入库数据单”表格内的 B2和B22单元格为文件名另存，将文件保存为“入库单\日期”的文件夹内。B2表示供应商、B22表示日期

liulang0808

建议楼主上传下模拟附件

乐乐2006201505

自己录制宏，试一下。

秋先森℡

liulang0808 发表于 2024-1-30 10:20
建议楼主上传下模拟附件

shang chuan le

feilanga

.................

1355311

SAVE AS 是能搞定的啊，

松永

看这个能否用

秋先森℡

松永 发表于 2024-1-30 15:09
看这个能否用

查不到保存的文件

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.1.30
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     Set ws = ThisWorkbook
   
6.     Set sh = ws.Sheets("入库数据")
   
7.     p = ThisWorkbook.Path & ""
   
8.     With sh
   
9.         xm = .[b2].Value
   
10.         rq = Format(.[b22].Value, "yyyy-m-d")
    
11.         Set Rng = .[b2:h22]
    
12.         fn = xm & "(" & rq & ")"
    
13.     End With
    
14.     p1 = p & "入库单"
    
15.     If Not fso.FolderExists(p1) Then fso.CreateFolder p1
    
16.     p2 = p1 & rq & ""
    
17.     If Not fso.FolderExists(p2) Then fso.CreateFolder p2
    
18.     sh.Copy
    
19.     Set wb = ActiveWorkbook
    
20.     With wb.Sheets(1)
    
21.         .DrawingObjects.Delete
    
22.         .Rows(1).Delete
    
23.         .UsedRange.Offset(22).Clear
    
24.     End With
    
25.     wb.SaveAs p2 & fn
    
26.     wb.Close
    
27.     Application.ScreenUpdating = True
    
28.     MsgBox "OK！"
    
29. End Sub
    

复制代码

ykcbf1100

附件供参考。。。