把各sheet生成新文件

学习vba2023

“源"文件有N个sheet。用VBA把各sheet生成单独的普通excel文件（各sheet内容保持不变）。

半百

佳能lT搬砖着

1. Sub 例子()
   
2.   Dim path As String
   
3.   Dim currentWB As Workbook
   
4.   Dim currentWS As Worksheet
   
5.   
   
6.   '获取源文件名
   
7.   Set currentWB = ActiveWorkbook
   
8.   path = currentWB.path & ""
   
9.   
   
10.   '循环遍历每个工作表，创建新工作簿并将工作表复制到新工作簿中
    
11.   For Each currentWS In currentWB.Worksheets
    
12.     Dim newWB As Workbook
    
13.     Set newWB = Workbooks.Add
    
14.     currentWS.Copy before:=newWB.Worksheets(1)
    
15.     newWB.Worksheets(2).Delete
    
16.     newWB.SaveAs Filename:=path & currentWS.Name
    
17.     newWB.Close
    
18.   Next currentWS
    
19.   
    
20.   '完成提示
    
21.   MsgBox "Done!"
    
22. End Sub
    

复制代码

学习vba2023

佳能lT搬砖着 发表于 2023-5-12 18:13

谢谢老师的解答。把生成的新文件放在一个文件夹中。已上传附件的效果。新文件夹的名称可以用同名。

zjzyj

佳能lT搬砖着 发表于 2023-5-12 18:13

老师请教一个问题，newWB=Workbooks.Add创建的新文件newWB的sheet最大行数是65536，如果thisworkbook是xlsm文件（sheet最大行号是1048576），则thisworkbook的sheet无法copy到newWB中，系统提示行数列数不够。请问这个问题如何解决？

佳能lT搬砖着

zjzyj 发表于 2023-5-16 22:55
老师请教一个问题，newWB=Workbooks.Add创建的新文件newWB的sheet最大行数是65536，如果thisworkbook是xl ...

Dim newWB As Workbook
    Set newWB = Workbooks.Add
   
    '复制thisworkbook的第一个sheet到newWB中
    ThisWorkbook.Sheets(1).Copy Before:=newWB.Sheets(1)
这样复制过去的sheet可以自动适应newWB的最大行数1048576。如果需要复制所有的sheet，可以使用循环来复制每一个sheet。

ykcbf1100

参与一下。

学习vba2023

ykcbf1100 发表于 2023-5-17 10:13
参与一下。

你好老师，如果不先预先设“分配”文件夹。 而是在运行代码新建一个与该操作excel文件同名的文件夹用来保存分配出来的各exel文件。比如同名“源”文件夹。