请教，如何按列表名称复制模板（sheet）并重命名

15358300083

因工作，需要新建大量工作簿，每次重命名都很繁琐。如何能批量复制模板工作簿并将新建的工作簿重命名为列表中的名称。

梦幻的流星

涉及到批量性的问题当然是用vba了

15358300083

梦幻的流星 发表于 2021-8-25 06:02
涉及到批量性的问题当然是用vba了

大佬，我按你这打了半天。运行起来才发现是新建了.xls。我想要的是复制"模板.sheet"按列表里的名称新建“1-201.sheet”。是我表达不清。

xlllw203

1. Sub xinjian()
   
2. 
   
3. Dim arr(), i, n, r
   
4. 
   
5. n = Worksheets("列表").UsedRange.Count - 1
   
6. ReDim arr(1 To n)
   
7. For i = 1 To n
   
8. arr(i) = Worksheets("列表").Cells(i + 1, 1)
   
9. Next
   
10. 
    
11. For r = 1 To UBound(arr)
    
12. Worksheets("模板").Copy after:=Worksheets(1 + r)
    
13. ActiveSheet.Name = arr(r)
    
14. Next
    
15. 
    
16. End Sub

复制代码

xlllw203

Sub xinjian()

Dim arr(), i, n, r

n = Worksheets("列表").UsedRange.Count - 1
ReDim arr(1 To n)
For i = 1 To n
arr(i) = Worksheets("列表").Cells(i + 1, 1)
Next

For r = 1 To UBound(arr)
Worksheets("模板").Copy after:=Worksheets(1 + r)
ActiveSheet.Name = arr(r)
Next

End Sub

loirol

附件供参考

15358300083

loirol 发表于 2021-8-25 15:38
附件供参考

这个真是太棒了，感谢

15358300083

xlllw203 发表于 2021-8-25 15:33
Sub xinjian()

Dim arr(), i, n, r

已经成功运行，十分感谢。

15358300083

15358300083 发表于 2021-8-25 19:42
已经成功运行，十分感谢。

经试用后，还是你这个代码更高效。