如何将批量新建的Excel工作表赋值给变量以用于后续循环操作

你已经有了批量创建工作表的VBA代码，现在想把这些新建的表对应到数组变量里方便后续操作，之前试的按索引赋值的方法显然不太靠谱——毕竟原工作簿可能早就有其他工作表，按索引拿肯定会出错对吧？

这里给你两种靠谱的方案，看你需求选：

方案一：创建工作表时直接存入数组（推荐） #

这种方法最稳妥，因为在创建工作表的同时就把对象存入数组，完全不用后续再去查找名称，还能自动跳过创建失败的重名表。

直接修改你原来的创建代码就行：

Sub AddSheetsWithArray()
    Dim cell As Excel.Range
    Dim wsWithSheetNames As Excel.Worksheet
    Dim wbToAddSheetsTo As Excel.Workbook
    Dim xlWs1 As Worksheet
    Dim Rng1 As Range
    ' 新增数组相关声明
    Dim wsArray() As Worksheet
    Dim arrIndex As Integer
    arrIndex = 0
    
    Set wsWithSheetNames = ActiveSheet
    Set wbToAddSheetsTo = ActiveWorkbook
    Set xlWs1 = Worksheets("template")
    Set Rng1 = xlWs1.Range("A1:AR2")
    
    For Each cell In wsWithSheetNames.Range("G3:G5") ' 按需修改区域
        With wbToAddSheetsTo
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = cell.Value
            
            ' 如果重命名成功（无错误），就把工作表存入数组
            If Err.Number = 0 Then
                arrIndex = arrIndex + 1
                ReDim Preserve wsArray(1 To arrIndex)
                Set wsArray(arrIndex) = ActiveSheet
                ' 顺便把模板内容复制过去
                Rng1.Copy ActiveSheet.Range("A1")
            Else
                Debug.Print cell.Value & " 已经被用作工作表名称，创建失败"
                ' 重命名失败的话，删掉刚新建的空白表
                ActiveSheet.Delete
            End If
            On Error GoTo 0
        End With
    Next cell
    
    ' 测试：遍历数组输出工作表名称
    Dim i As Integer
    For i = 1 To UBound(wsArray)
        Debug.Print "数组第" & i & "个工作表：" & wsArray(i).Name
    Next i
End Sub

关键点说明： #

• 新增了wsArray数组来存工作表对象，arrIndex用来跟踪数组的当前索引
• 重命名成功后才会把工作表加入数组，同时复制模板内容；如果重命名失败，直接删掉新建的空白表，避免冗余
• 最后加了一段测试代码，方便你验证数组里的内容是否正确

方案二：创建完成后，按单元格值查找工作表存入数组 #

如果你已经创建完所有工作表，只是想事后把对应名称的表存入数组，可以用这个方法：

Sub AssignSheetsToArrayAfterCreation()
    Dim wsWithSheetNames As Excel.Worksheet
    Dim wsArray() As Worksheet
    Dim cell As Range
    Dim i As Integer, n As Integer
    
    Set wsWithSheetNames = ActiveSheet
    n = wsWithSheetNames.Range("G3:G5").Count
    ReDim wsArray(1 To n)
    i = 1
    
    For Each cell In wsWithSheetNames.Range("G3:G5")
        On Error Resume Next
        ' 按单元格值查找工作表
        Set wsArray(i) = ThisWorkbook.Worksheets(cell.Value)
        On Error GoTo 0
        
        ' 处理找不到工作表的情况
        If wsArray(i) Is Nothing Then
            Debug.Print "未找到工作表：" & cell.Value
        Else
            Debug.Print "已将工作表 " & cell.Value & " 存入数组第" & i & "位"
        End If
        i = i + 1
    Next cell
End Sub

关键点说明： #

• 遍历你用来创建工作表的单元格区域，逐个按名称查找工作表
• 用On Error Resume Next跳过查找失败的情况（比如名称重复导致没创建成功），并通过Is Nothing判断是否查找成功

两种方案各有适用场景，方案一适合创建和赋值一步到位，方案二适合事后批量整理。

内容的提问来源于stack exchange，提问作者Hwee7