[已解决]另存的问题

yl.fu

请教下大师傅，我有一个另存的问题，比如一个工作簿中有多个工作表，前四个工作表1. 2. 3. 4不需另存 其余各自命名为301djr01  301djr02  ~~  
每表个中I3 为各自名字 301djr01  301djr02  ~~        I5格是路径 比如对应 c:\301\301djr01.prt     d:\301\301djr02.prt  ~~~~
如何另存为各自路径下为 301djr01.xls        301djr02 .xls        ~~~~谢谢

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-5-11 10:52

1. Sub 批量另存()
   
2.     Dim i As Byte
   
3.     On Error GoTo ErrorHandler
   
4. 
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     For i = 5 To Worksheets.Count
   
8.         Worksheets(i).Copy
   
9.         MkDir Range("i5").Value
   
10.         ActiveWorkbook.SaveAs Filename:=Replace(Range("i5").value, ".prt", ".xls"), FileFormat:=xlExcel8
    
11.         ActiveWorkbook.Close True
    
12.     Next
    
13.     Application.ScreenUpdating = True
    
14.     Application.DisplayAlerts = True
    
15.     MsgBox "OK"
    
16. 
    
17. ErrorHandler:
    
18.     Debug.Print Err.Number & Err.Description
    
19.     Resume Next
    
20. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

你是要导出某个工作表另存还是直接工作簿另存？

hwc2ycy

1. Sub 批量另存()
   
2.     Dim i As Byte
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     For i = 5 To Worksheets.Count
   
6.         Worksheets(i).Copy
   
7.         ActiveWorkbook.SaveAs Filename:=Range("i5") & "" & Range("i3"), FileFormat:=xlExcel8
   
8.         ActiveWorkbook.Close True
   
9.     Next
   
10.     Application.ScreenUpdating = True
    
11.     Application.DisplayAlerts = True
    
12.     MsgBox "OK"
    
13. End Sub

复制代码

yl.fu

导出个工作表，谢谢

yl.fu

导出个工作表，xiexie

yl.fu

hwc2ycy 发表于 2013-5-10 22:25

大师测试报警出现不能打开c:\301djr01.prt  不知如何处理谢谢

hwc2ycy

yl.fu 发表于 2013-5-10 22:54
大师测试报警出现不能打开c:\301djr01.prt  不知如何处理谢谢

文件夹存在不？

hwc2ycy

1. Sub 批量另存()
   
2.     Dim i As Byte
   
3.     On Error GoTo ErrorHandler
   
4. 
   
5.     Application.ScreenUpdating = False
   
6.     Application.DisplayAlerts = False
   
7.     For i = 5 To Worksheets.Count
   
8.         Worksheets(i).Copy
   
9.         MkDir Range("i5").Value
   
10.         ActiveWorkbook.SaveAs Filename:=Range("i5") & "" & Range("i3"), FileFormat:=xlExcel8
    
11.         ActiveWorkbook.Close True
    
12.     Next
    
13.     Application.ScreenUpdating = True
    
14.     Application.DisplayAlerts = True
    
15.     MsgBox "OK"
    
16. 
    
17. ErrorHandler:
    
18.     Debug.Print Err.Number & Err.Description
    
19.     Resume Next
    
20. End Sub
    

复制代码

yl.fu

hwc2ycy 发表于 2013-5-11 08:15

不好意思在麻烦下大师，我的I5中是 比如c:\301djr01.prt    是另外一个文件 *.prt 路径     我想保存为c:\301djr01.xls 不要建301djr01.prt  (资料夹)\ 301djr01.xls        谢谢

yl.fu

hwc2ycy 发表于 2013-5-11 08:09
文件夹存在不？

301djr01.prt  是一个文件 ，此文件现没有，不知是不是这个原因