【原】用列信息批量生成工作表，看这篇就够了

▎写在前面

本文通过一个简单的案例，详细讲解批量生成多个工作表的VBA需求，并考虑可能出现的一些问题，加深对If条件判断的使用。新手建议一步一步根据文章内容进行测试。

▎案例需求

实际需求模拟如下：

以当前工作表作为模板表格，以H列信息作为需要生成的工作表名称，批量生成。

实现代码：

Sub 批量生成工作表() Application.ScreenUpdating = False '取消屏幕刷新，加快速度 Set sht = Worksheets("模板") '将名字为模板的sheet赋值给对象变量sht For i = 2 To sht.Cells(Rows.Count, "h").End(3).Row '对H列数据进行循环 sht.Copy After:=Worksheets(Worksheets.Count) '录制宏可得到该句代码，目的是将模板表复制并且新增作为最后一个表格 Worksheets(Worksheets.Count).Name = sht.Cells(i, "h") '修改sheet的名字为H列的具体单元格名字 Next Application.ScreenUpdating = True '开启屏幕刷新 MsgBox "完成！"End Sub

核心语句：  sht.Copy After:=Worksheets(Worksheets.Count)，其中为什么这块是Worksheets.Count ，是因为新建的Sheet默认都是在最后一个。所以可以通过索引号直接获取新建的Sheet。这一句可以通过以下步骤录制宏来获取。

录制宏的语句：

Sub 宏1() Sheets("对照表").Copy After:=Sheets(1)End Sub

代码整体运行结果：

但是现在这种情况有个小问题，就是列信息和模板都在同一个sheet里面，这就导致，生成的sheet里面都包含有多余的信息。我们再加两句删除多余信息的代码即可。

Sub 批量生成工作表() Application.ScreenUpdating = False '取消屏幕刷新，加快速度 Set sht = Worksheets("模板") '将名字为模板的sheet赋值给对象变量sht For i = 2 To sht.Cells(Rows.Count, "h").End(3).Row '对H列数据进行循环 sht.Copy After:=Worksheets(Worksheets.Count) '录制宏可得到该句代码，目的是将模板表复制并且新增作为最后一个表格 Worksheets(Worksheets.Count).Name = sht.Cells(i, "h") '修改sheet的名字为H列的具体单元格名字 Worksheets(Worksheets.Count).Columns("h").Delete'删除H列信息        Worksheets(Worksheets.Count).Shapes("按钮 1").Delete'删除程序执行按钮 Next Application.ScreenUpdating = True '开启屏幕刷新 MsgBox "完成！"End Sub

当然，根据实际情况来，如果把Sheet名列和模板Sheet不在一个Sheet里面的话，就不必这两句删除代码了。

▎变化的情形

▶如果新增的某个Sheet已经存在，程序就会报错。这个时候我们在新增Sheet之前，就要增加一个判断是否已存在相同名字表格的判断。这里，我们使用一个自定义函数IsSheetExisted。

完整代码：

Sub 批量生成工作表2() Application.ScreenUpdating = False '取消屏幕刷新，加快速度 Set sht = Worksheets("模板") '将名字为模板的sheet赋值给对象变量sht For i = 2 To sht.Cells(Rows.Count, "h").End(3).Row '对H列数据进行循环 If IsSheetExisted(sht.Cells(i, "h")) = False Then sht.Copy After:=Worksheets(Worksheets.Count) '录制宏可得到该句代码，目的是将模板表复制并且新增作为最后一个表格 Worksheets(Worksheets.Count).Name = sht.Cells(i, "h") '修改sheet的名字为H列的具体单元格名字 Worksheets(Worksheets.Count).Columns("h").Delete Worksheets(Worksheets.Count).Shapes("按钮 1").Delete End If Next Application.ScreenUpdating = True MsgBox "完成！"End SubFunction IsSheetExisted(tabname As String) As Boolean Dim sht As Worksheet For Each sht In Worksheets If sht.Name = tabname Then IsSheetExisted = True Exit Function End If Next IsSheetExisted = FalseEnd Function


‍

‍

▶如果H列有空单元格，则会造成新建表格命名的时候失败。这个时候我们需要再加1个条件判断，当H列信息不为空的时候，才进行新建Sheet操作。

Sub 批量生成工作表2() Application.ScreenUpdating = False '取消屏幕刷新，加快速度 Set sht = Worksheets("模板") '将名字为模板的sheet赋值给对象变量sht For i = 2 To sht.Cells(Rows.Count, "h").End(3).Row '对H列数据进行循环 If sht.Cells(i, "h") <> "" Then If IsSheetExisted(sht.Cells(i, "h")) = False Then sht.Copy After:=Worksheets(Worksheets.Count) '录制宏可得到该句代码，目的是将模板表复制并且新增作为最后一个表格 Worksheets(Worksheets.Count).Name = sht.Cells(i, "h") '修改sheet的名字为H列的具体单元格名字 Worksheets(Worksheets.Count).Columns("h").Delete Worksheets(Worksheets.Count).Shapes("按钮 1").Delete End If End If Next Application.ScreenUpdating = True MsgBox "完成！"End SubFunction IsSheetExisted(tabname As String) As Boolean Dim sht As Worksheet For Each sht In Worksheets If sht.Name = tabname Then IsSheetExisted = True Exit Function End If Next IsSheetExisted = FalseEnd Function

各种情形都写出来了，最重要的不是代码本身，是根据各种情况，如何使用条件语句判断的逻辑才是核心。