VBA-批量新建SHEET，并重命名

上次我们说过利用VBA批量新建、删除SHEET。有的朋友就问了，是可以批量新建那么多SHEET，但是我不想叫SHEET1,SHEET2,SHEET3，想根据实际情况把所有SHEET一次性新建好，并命名。所以今天就来跟大家说一说如何一次性新建想要的SHEET数量，并且重命名。
先来看下完成的效果图。

因为无法用代码去直接确定你要新建SHEET的名称，或者说把新建名称写入代码比较死板，所以我先在SHEET1中放入了我想要的新建后修改的名称。这样的话，我写几个名称，代码就会根据名称的数量去新建，并且按顺序去批量修改名称。
附上代码：

Sub 新建sheet并改名()

复制代码

Dim i, j As Integer

复制代码

Dim sht As Worksheet

复制代码

Application.DisplayAlerts = False

复制代码

Application.ScreenUpdating = False

复制代码

For Each sht In Worksheets

复制代码

If sht.Name ActiveSheet.Name Then

复制代码

sht.Delete

复制代码

End If

复制代码

Next

复制代码

i = Sheets(1).Range("a65536").End(xlUp).Row

复制代码

For j = 1 To i

复制代码

Set sht = Sheets.Add(after:=Sheets(Sheets.Count))

复制代码

sht.Name = Sheets(1).Range("a" & j)

复制代码

Next

复制代码

Sheets(1).Select

复制代码

Application.DisplayAlerts = True

复制代码

Application.ScreenUpdating = True

复制代码

End Sub

复制代码

为了方便动图的演示，我加了下方这段代码，可以不要。它的作用是遍历所有工作表，如果工作表的名称不等于当前激活工作表的名称就删除，可以不要这段。

For Each sht In Worksheets

复制代码

If sht.Name ActiveSheet.Name Then

复制代码

sht.Delete

复制代码

End If

复制代码

Next

复制代码

所以需要的代码就是剩下的部分。

Sub 新建sheet并改名()

复制代码

Dim i, j As Integer

复制代码

Dim sht As Worksheet

复制代码

Application.DisplayAlerts = False

复制代码

Application.ScreenUpdating = False

复制代码

For Each sht In Worksheets

复制代码

If sht.Name ActiveSheet.Name Then

复制代码

sht.Delete

复制代码

End If

复制代码

Next

复制代码

i = Sheets(1).Range("a65536").End(xlUp).Row

复制代码

For j = 1 To i

复制代码

Set sht = Sheets.Add(after:=Sheets(Sheets.Count))

复制代码

sht.Name = Sheets(1).Range("a" & j)

复制代码

Next

复制代码

Sheets(1).Select

复制代码

Application.DisplayAlerts = True

复制代码

Application.ScreenUpdating = True

复制代码

End Sub

复制代码

代码的第11行，Sheets(1).Select同样是为了方便演示所用。如果大家觉得我把所有Sheet都新建完成了，Sheet1没什么用了，直接把Sheets(1).Delete删除即可。