【原】Excel VBA 小技巧/1秒创建100个工作表

您可以通过以下方式支持我：1、关注、点赞、留言、分享、打赏；2、点击感兴趣的广告、购买我的安利微店产品；3、添加我的合谷医疗企业微信，谢谢！

☆本期内容概要☆

• 数据透视表法批量创建工作表

• VBA代码批量创建指定名称工作表

• VBA代码批量删除指定名称工作表
  

大家好，我是冷水泡茶，我们前面分享了批量处理EXCEL工作簿、批量处理文件夹等方法：

1、总表拆分，拆成单独文件：Excel VBA 总表按项目拆分明细表/考勤表按部门拆分为单独文件

2、总表拆分，按项目汇总：Excel VBA 按项目把总表拆分表明细表/真实案例

3、批量创建文件夹：EXCEL VBA 批量创建多层文件夹/批处理文件批量创建文件夹

4、批量移动文件：Excel VBA 批量创建EXCEL工作簿、批量移动文件

今天给大家分享的是在同一个EXCEL工作簿中，批量创建指定名称工作表、批量删除指定名称。

1、数据透视表法批量创建工作表：假设我们需要插入以01月-12月份命名的工作表

（1）在一张空白的表中，A1输入“工作表名”，A2~A13输入01-12月字段

（2）选中A列，插入数据透视表

（3）把“工作表名”字段拖到“筛选”区

（4）点数据透视表中“工作表名”右侧单元格的下拉箭头，再点“选择多项”，把“空白”字段前的勾去掉。

（5）选中数据透视表中的“工作表名”字段，点击菜单“分析”、“数据透视表“、“选项”（下拉箭头）、“显示报表筛选页”、“确定”

（6）12张表插入成功，每张表都是一个数据透视表。如果不需要这些数据透视表，可以一起选中这12张表，按“Delete”键，就得到12张以月份命名的空白表格。

（7）当然，数据透视表的这种操作，根本目的不是为了插入工作表，而是把筛选的关键字分别显示为单独的工作表，便于查看，可以随数据源的变化而一起更新。

2、VBA代码法：

（1）参照前述，先在Sheet1表中输入每个月的字段。

（2）打开VBA编辑器，插入模块1,输入以下代码：

（A）创建工作表：

Sub CreateNewSheets()    Dim ws As Worksheet    Dim NewWs As Worksheet    Dim lastRow As Integer    Dim wsName As String    t = 0    Set ws = ThisWorkbook.Sheets("Sheet1")    ws.Activate    lastRow = ws.UsedRange.Rows.Count    For i = 2 To lastRow        wsName = ws.Cells(i, 1)        If wsName <> "" Then            On Error Resume Next            Set NewWs = ThisWorkbook.Worksheets(wsName)            On Error GoTo 0            If NewWs Is Nothing Then                t = t + 1                With ActiveWorkbook                    Set NewWs = .Worksheets.Add(after:=.Sheets(.Sheets.Count))                    NewWs.Name = wsName                End With            End If            Set NewWs = Nothing        End If    Next    ws.Activate    MsgBox "成功添加【" & t & "】张工作表！"End Sub

（B）删除工作表：

Sub deleteSheets()    Dim ws As Worksheet    Dim currWs As Worksheet    Dim lastRow As Integer    Dim wsName As String    Application.DisplayAlerts = False    t = 0    Set ws = ThisWorkbook.Sheets("Sheet1")    ws.Activate    lastRow = ws.UsedRange.Rows.Count    For i = 2 To lastRow        wsName = ws.Cells(i, 1)        If wsName <> "" Then            On Error Resume Next            Set currWs = ThisWorkbook.Worksheets(wsName)            On Error GoTo 0            If Not currWs Is Nothing Then                t = t + 1                currWs.Delete            End If            Set currWs = Nothing        End If    Next    Application.DisplayAlerts = True    MsgBox "成功删除【" & t & "】张工作表！"End Sub

（3）在sheet1中插入两个命令按钮：

Private Sub CmdCreateSheets_Click()    Call CreateNewSheetsEnd SubPrivate Sub CmdDeleteSheets_Click()    Call deleteSheetsEnd Sub