如何在VBA中基于变量存储的指定工作表名后新增Excel工作表？

如何通过VBA在Excel中，在变量存储的指定工作表名称之后新增工作表？
尝试使用语句：Set sh = wb.Worksheets.Add(After:=wb.Sheets(wsPattern & CStr(n)))，其中递增值拼接的工作表名存储在wsPattern & CStr(n)中，新工作表名称的递增值可正常生成，但执行时触发“超出范围”错误。
使用Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))可正常执行，但会将所有新工作表添加至工作簿末尾。
当前工作簿包含4组递增命名的工作表系列（如Test1、logistic1、Equip1、Veh1等），需要将同系列的下一个递增工作表添加至该系列的最后一个工作表之后（如Equip2需添加在Equip1之后），而非工作簿末尾。

附原代码：

Sub CreaIncWkshtEquip()
    
    Const wsPattern As String = "Equip "
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim arr() As Long: ReDim arr(1 To wb.Sheets.Count)
    Dim wsLen As Long: wsLen = Len(wsPattern)
    Dim sh As Object
    Dim cValue As Variant
    Dim shName As String
    Dim n As Long
    
    For Each sh In wb.Sheets
        shName = sh.Name
        If StrComp(Left(shName, wsLen), wsPattern, vbTextCompare) = 0 Then
            cValue = Right(shName, Len(shName) - wsLen)
            If IsNumeric(cValue) Then
                n = n + 1
                arr(n) = CLng(cValue)
            End If
        End If
    Next sh
    If n = 0 Then
        n = 1
    Else
        ReDim Preserve arr(1 To n)
        For n = 1 To n
            If IsError(Application.Match(n, arr, 0)) Then
                Exit For
            End If
        Next n
    End If
    
    'adds to very end of workbook
    'Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    
    'Test-Add After Last Incremented Sheet-
    Set sh = wb.Worksheets.Add(After:=wb.Sheets(wsPattern & CStr(n)))
       
    sh.Name = wsPattern & CStr(n)
End Sub 

报错核心原因：wsPattern & CStr(n)是待创建的新工作表名称，当前工作簿中不存在该工作表，用它作为wb.Sheets()的索引自然会触发“下标超出范围”错误。需要定位的是同系列中已存在的最后一个工作表，而非即将创建的目标工作表。

修改代码，在遍历工作表时记录同系列中位置最靠后的工作表对象，以此作为新工作表的插入参照。

修改后的代码：

Sub CreaIncWkshtEquip()
    
    Const wsPattern As String = "Equip "
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim arr() As Long: ReDim arr(1 To wb.Sheets.Count)
    Dim wsLen As Long: wsLen = Len(wsPattern)
    Dim sh As Object
    Dim cValue As Variant
    Dim shName As String
    Dim n As Long
    Dim lastSeriesSheet As Object ' 存储同系列最后一个工作表
    
    Set lastSeriesSheet = Nothing ' 初始化变量
    
    For Each sh In wb.Sheets
        shName = sh.Name
        If StrComp(Left(shName, wsLen), wsPattern, vbTextCompare) = 0 Then
            cValue = Right(shName, Len(shName) - wsLen)
            If IsNumeric(cValue) Then
                n = n + 1
                arr(n) = CLng(cValue)
                Set lastSeriesSheet = sh ' 遍历到同系列工作表时更新，最终得到位置最靠后的那个
            End If
        End If
    Next sh
    
    If n = 0 Then
        n = 1
    Else
        ReDim Preserve arr(1 To n)
        For n = 1 To n
            If IsError(Application.Match(n, arr, 0)) Then
                Exit For
            End If
        Next n
    End If
    
    ' 根据是否存在同系列工作表决定插入位置
    If lastSeriesSheet Is Nothing Then
        ' 无同系列工作表，添加到工作簿末尾
        Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    Else
        ' 添加到同系列最后一个工作表之后
        Set sh = wb.Worksheets.Add(After:=lastSeriesSheet)
    End If
       
    sh.Name = wsPattern & CStr(n)
End Sub 

关键修改说明 #

• 新增lastSeriesSheet变量，遍历过程中持续更新为当前遇到的同系列工作表，最终会指向该系列中位置最靠后的工作表。
• 插入新工作表时做判断：
  • 若lastSeriesSheet为空，说明系列无已存在工作表，直接添加到工作簿末尾。
  • 若不为空，则将新表插入到该工作表之后，实现同系列工作表的连续排列。

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