导出表到新簿

ykcbf1100

工作簿另存

1. Sub ykcbf()  '//2024.8.11
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     fn = Application.InputBox("请输入另存工作簿名称：", "新工作簿名", "新工作簿")
   
5.     rq = Application.InputBox("请输入另存文件名用的日期：", "自定义日期格式", "20240811")
   
6.     With Application.FileDialog(msoFileDialogFolderPicker)
   
7.         .Title = "请选择另存工作簿文件夹"
   
8.         .InitialFileName = ThisWorkbook.Path & ""
   
9.         If .Show = -1 Then
   
10.             p = .SelectedItems(1) & ""
    
11.         End If
    
12.     End With
    
13.     Set ws = ThisWorkbook
    
14.     ws.Sheets(Array("供应", "生产", "销售")).Copy
    
15.     Set wb = ActiveWorkbook
    
16.     wb.SaveAs Filename:=p & fn & rq & ".xls", FileFormat:=56
    
17.     wb.Close
    
18.     Application.ScreenUpdating = False
    
19.     MsgBox "OK！"
    
20. End Sub
    
21. 
    

复制代码

ddz79101

ykcbf1100 发表于 2024-8-11 16:42
参与一下。。。

谢谢老师！运行时出状况了。见图

ykcbf1100

ddz79101 发表于 2024-8-11 17:57
谢谢老师！运行时出状况了。见图

我这里正常的，估计你是在选择文件夹时出了问题。如果是选择当前文件夹，直接点确定即可，如果不是当前文件夹，选择一个其中一个文件夹即可。

ddz79101

ykcbf1100 发表于 2024-8-11 18:47
我这里正常的，估计你是在选择文件夹时出了问题。如果是选择当前文件夹，直接点确定即可，如果不是当前文 ...

谢谢老师！