[已解决]excel指定名称多次复制一个工作表

icenotcool

老师好，我想复制一个工作表，同时复制100次，并且同时指定名称，谢谢，附件 举例.rar (2.87 KB, 下载次数: 20)

2013-10-28 00:38 上传

点击文件名下载附件

Sub test()

Dim i&, j&

    j= Val(ActiveSheet.Name)

   For i = 1 To 50

       ActiveSheet.Copy After:=ActiveSheet

       ActiveSheet.Name = ""'(不知怎么写)

   Next

End Sub

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-10-28 08:23

改一下，对于重名的不再做复制。

1. Sub tset()
   
2.     Dim arr, arrItem
   
3.     Dim strShtname$
   
4.     Dim k As Integer
   
5.     On Error Resume Next
   
6.     strShtname = "被复制表格"
   
7.     arr = Sheet1.Range("a1").CurrentRegion.Value
   
8.     Application.ScreenUpdating = False
   
9.     For Each arrItem In arr
   
10.         If Len(Worksheets(arrItem).Name) < 0 Then
    
11.             k = k + 1
    
12.             Worksheets(strShtname).Copy after:=Worksheets(Worksheets.Count)
    
13.             ActiveSheet.Name = arrItem
    
14.         End If
    
15.     Next
    
16.     Application.ScreenUpdating = True
    
17.     If k Then
    
18.         strShtname = "一共复制了 " & k & " 个工作表复制完成"
    
19.     Else
    
20.         strShtname = "指定名称的工作表已经存在于工作簿当中，复制失败"
    
21.     End If
    
22.     MsgBox strShtname
    
23. End Sub
    

复制代码

跳转到最佳答案楼层

hwc2ycy

ActiveSheet.Name = ""'(不知怎么写)
这里工作表的名字，肯定是得有规律的，不然没法写。

hwc2ycy

1. Sub tset()
   
2.     Dim arr, arrItem
   
3.     Dim strShtname$
   
4.     On Error Resume Next
   
5.     strShtname = "被复制表格"
   
6.     arr = Sheet1.Range("a1").CurrentRegion.Value
   
7.     Application.ScreenUpdating = False
   
8.     For Each arrItem In arr
   
9.         Worksheets(strShtname).Copy after:=Worksheets(Worksheets.Count)
   
10.         ActiveSheet.Name = arrItem
    
11.     Next
    
12.     Application.ScreenUpdating = True
    
13.     MsgBox "工作表复制完成", vbInformation
    
14. End Sub
    

复制代码

icenotcool

老师我说的工作表名称预定在“复制表名称”A2:A41区域里面，谢谢老师了！

hwc2ycy

改一下，对于重名的不再做复制。

1. Sub tset()
   
2.     Dim arr, arrItem
   
3.     Dim strShtname$
   
4.     Dim k As Integer
   
5.     On Error Resume Next
   
6.     strShtname = "被复制表格"
   
7.     arr = Sheet1.Range("a1").CurrentRegion.Value
   
8.     Application.ScreenUpdating = False
   
9.     For Each arrItem In arr
   
10.         If Len(Worksheets(arrItem).Name) < 0 Then
    
11.             k = k + 1
    
12.             Worksheets(strShtname).Copy after:=Worksheets(Worksheets.Count)
    
13.             ActiveSheet.Name = arrItem
    
14.         End If
    
15.     Next
    
16.     Application.ScreenUpdating = True
    
17.     If k Then
    
18.         strShtname = "一共复制了 " & k & " 个工作表复制完成"
    
19.     Else
    
20.         strShtname = "指定名称的工作表已经存在于工作簿当中，复制失败"
    
21.     End If
    
22.     MsgBox strShtname
    
23. End Sub
    

复制代码

icenotcool

谢谢老师，可以，这就是我想要的意思！