如何用VBA批量新建工作表并重命名工作表

星星人类

在我的文档中，我先建总页中的品名，然后按样表新建工作表，再按序号重命名工作表，需做二步，可否请高手帮我改一下VBA，一步就可以批量生成N张工作表并按序号重命名工作表

[ 本帖最后由 星星人类 于 2010-1-19 21:51 编辑 ]

星星人类

因为第一次批量新建工作表，生成的工作表名是1、2、3、..............
我希望批量新建工作表，生成的工作表名是001、002、003、..............
这个编号顺序按总页的序号一样，如总页中序号是A01、A02、A03...........生成的工作表名也是A01、A02、A03...........
还有VBA有个出错提示，也帮我改一下了，谢谢了

[ 本帖最后由 星星人类 于 2010-1-19 13:58 编辑 ]

星星人类

等待中。。。。。。。。。。。

zhaogang1960

请测试：
Private Sub CommandButton1_Click()
    Dim arr, sh As Worksheet
    arr = Range("b5:b" & Range("b65536").End(xlUp).Row - 1)
    shtNum = Application.InputBox("请输入复制工作表的张数", Type:=1)
    If shtNum = 0 Then Exit Sub
    If shtNum > UBound(arr) Then shtNum = UBound(arr)
    Application.ScreenUpdating = False
    On Error Resume Next
    With ThisWorkbook.Worksheets("样表")
        For i = 1 To shtNum
            Set sh = Sheets(arr(i, 1))
            If sh Is Nothing Then
                .Copy After:=Sheets(ThisWorkbook.Worksheets.Count)
                ActiveSheet.Name = arr(i, 1)
            End If
            Set sh = Nothing
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

[ 本帖最后由 zhaogang1960 于 2010-1-19 16:54 编辑 ]

星星人类

谢谢，经测试可以了！！！

HCF229007

学习了，但不知道代码怎样编写。

sdong7

1. 
   
2. Sub 批量新建并命名工作表() 'bysdong720170707按序号命名工作表
   
3. Application.ScreenUpdating = False '开启屏幕刷新对话框
   
4. Application.DisplayAlerts = False '关闭屏幕警告对话框
   
5. Dim arr
   
6. mxr = [A1048576].End(xlUp).Row
   
7. arr = Range("a2:d" & mxr)
   
8. For i = 1 To UBound(arr, 1)
   
9. Sheets.Add before:=Sheets(i)
   
10.     Sheets(i).Name = arr(i, 1)
    
11. Next i
    
12.    Sheets("总页").Activate
    
13. Application.DisplayAlerts = True '开启屏幕警告对话框
    
14. Application.ScreenUpdating = True '开启屏幕刷新对话框
    
15. End Sub

复制代码

sdong7

按序号命名工作表
下面代码是批量删除工作表

sdong7

1. Sub 批量删除工作表() 'bysdong720170707
   
2. Application.ScreenUpdating = False '开启屏幕刷新对话框
   
3. Application.DisplayAlerts = False '关闭屏幕警告对话框
   
4. For i = Worksheets.Count To 1 Step -1 'Worksheets.Count统计工作的总数，整句代码的意思遍历每一个作表
   
5. If Sheets(i).Name <> "总页" Then
   
6. Sheets(i).Delete
   
7. Sheets("总页").Activate
   
8. End If
   
9. Next i
   
10. End Sub
    

复制代码

sdong7

下面上传附件，仅供参考