工作表单独另存报错求教

转角处的沉思

如截图，想要单独另存一页工作表，报错下标越界，求教，感谢。

Qs18

1. Sub LC()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.    
   
5.     Dim svdName As String
   
6.     Dim svdFile As String
   
7.     f = Sheets(1).Range("B1")
   
8.     svdName = "另存_" & f & Format(Now(), "_YYYY-MM-DD-HH-MM") & ".xlsx"
   
9.    
   
10.     svdFile = "d:" & f & "" & svdName
    
11.    
    
12.     Sheets("另存").Copy
    
13.    
    
14.     ActiveWorkbook.SaveAs svdFile
    
15.    
    
16.     ActiveWorkbook.Close
    
17.    
    
18.     Application.ScreenUpdating = True
    
19.     Application.DisplayAlerts = True
    
20. End Sub

复制代码

醉眼看尘世

产生错误的原因是D盘中没有W-24XX文件夹

醉眼看尘世

在
f=....b1这句下面添一句
If Dir("D:\" & f, vbDirectory) = "" Then MkDir "D:\" & f
即可

转角处的沉思

Qs18 发表于 2024-9-10 14:53

感谢帮助，运行不报错了，不过也没有保存到对应文件夹下去。

转角处的沉思

醉眼看尘世 发表于 2024-9-10 15:06
在
f=....b1这句下面添一句
If Dir("D:\" & f, vbDirectory) = "" Then MkDir "D:\" & f

感谢帮忙，文件夹有的，加了这句还是同样的报错。

ykcbf1100

原代码小改一下。

ykcbf1100

小改一下，测试成功。

1. Sub LC()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim svdName As String
   
5.     Dim svdFile As String
   
6.     f = Sheets(1).Range("B1")
   
7.     svdFile = "D:" & f & ""
   
8.     If Dir(svdFile, vbDirectory) = "" Then MkDir svdFile
   
9.     svdName = "另存_" & f & Format(Now(), "_YYYY-MM-DD-HH-MM") & ".xlsx"
   
10.     Sheets("另存").Copy
    
11.     ActiveWorkbook.SaveAs svdFile & svdName
    
12.     ActiveWorkbook.Close
    
13.     Application.ScreenUpdating = True
    
14.     Application.DisplayAlerts = True
    
15. End Sub
    

复制代码

醉眼看尘世

转角处的沉思 发表于 2024-9-10 15:10
感谢帮忙，文件夹有的，加了这句还是同样的报错。

ActiveWorkbook.SaveAs svdFile改成
ActiveWorkbook.SaveAs svdFile,51

转角处的沉思

ykcbf1100 发表于 2024-9-10 15:20
小改一下，测试成功。

感谢帮助，代码应该是没问题的，不过可能由于最近微软新的安全策略，第一次运行发现也是没有保存，在代码里追条运行到提示修改敏感度后另存成功。