添加具有顺序名称的图纸在第10张图纸之后停止递增

Question

我在寻找使用VBA顺序添加图纸的方法时遇到了以下代码。这段代码运行得很好，它完全符合我的要求，直到它到达第10个工作表。一旦它到达第10页(即"Combined-10"(，它在试图前进到第11页时就会抛出错误。我对VBA还很陌生，不知道如何更正。我只是需要帮助解决这个问题，以便工作表在到达第10张后继续前进到下一张连续的工作表。任何帮助都将不胜感激！

链接到原始代码：添加具有顺序名称的图纸添加具有顺序名称的图纸

Option Explicit
Sub GetAvailableSheeName()
Dim sht As Worksheet
Dim temp_sht
Dim sht_name, last_sht As String
Dim shtNumber
Dim temp_counter, loop_i, counter, num As Integer
Const Available_sht As String = "Combined-"
temp_counter = 0
For Each sht In ThisWorkbook.Worksheets
If LCase(Left(sht.name, Len(Available_sht))) = LCase(Available_sht) Then
shtNumber = Split(sht.name, "-")(1)
If IsNumeric(shtNumber) Then
If shtNumber > temp_counter Then
temp_counter = shtNumber
last_sht = sht.name
End If
Else
sht_name = sht.name
End If
Else
sht_name = sht.name
End If
Next sht
If temp_counter = 0 Then
ThisWorkbook.Sheets.Add(After:=Sheets(sht_name)).name = "Combined-1"
Else
ThisWorkbook.Sheets.Add(After:=Sheets(last_sht)).name = "Combined-" & temp_counter + 1
For loop_i = 1 To temp_counter + 1
For Each sht In ThisWorkbook.Worksheets
counter = 0
If LCase("Combined-") & loop_i = LCase(sht.name) Then
counter = 1
Exit For
End If
Next sht
If counter = 0 Then
If loop_i = 1 Then
ThisWorkbook.Sheets.Add(Before:=Sheets(1)).name = "Combined-" & loop_i
Else
num = loop_i - 1
ThisWorkbook.Sheets.Add(After:=Sheets("Combined-" & num)).name = "Combined-" & loop_i
End If
End If
Next loop_i
End If
End Sub

Answer 1

添加具有顺序名称的工作表

紧凑型

Sub GetAvailableSheetName()
On Error GoTo ClearError

Dim ws As Worksheet
Dim n As Long
Dim wsName As String

Do
n = n + 1
wsName = "Combined-" & n
Set ws = ThisWorkbook.Worksheets(wsName)
Loop

WorksheetNaming:
On Error Resume Next
ThisWorkbook.Worksheets .Add(After:=ThisWorkbook _
.Sheets(ThisWorkbook.Sheets.Count)).Name = wsName
On Error GoTo 0

Exit Sub
ClearError:
Resume WorksheetNaming
End Sub

论证

Sub AddSequentialSheetNameTEST()
AddSequentialSheetName ThisWorkbook, "Combined-"
MsgBox "Added the worksheet '" & ActiveSheet.Name, vbInformation
End Sub

Sub AddSequentialSheetName( _
ByVal wb As Workbook, _
Optional ByVal Prefix As String = "Sheet", _
Optional ByVal Suffix As String = "")
On Error GoTo ClearError

Dim ws As Worksheet
Dim n As Long
Dim wsName As String

Do
n = n + 1
wsName = Prefix & n & Suffix
Set ws = wb.Worksheets(wsName)
Loop

WorksheetNaming:
On Error Resume Next
wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = wsName
On Error GoTo 0

Exit Sub
ClearError:
Resume WorksheetNaming
End Sub