使用VBA添加工作表时避免重复创建

核心思路是用**集合（Collection）**来追踪已创建的工作表名称——集合不允许重复键，刚好可以自动过滤重复值，避免重复创建工作表。

直接可用的VBA代码 #

Sub AddUniqueSheetsFromColumn()
    Dim wsSource As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim sheetName As String
    Dim existingSheets As New Collection
    
    ' 替换成你的数据源工作表名称
    Set wsSource = ThisWorkbook.Worksheets("数据源")
    
    ' 获取目标列的最后一行（这里用A列，可改成其他列，比如"B"）
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历列中数据（从第2行开始，跳过表头）
    For Each cell In wsSource.Range("A2:A" & lastRow)
        sheetName = Trim(cell.Value)
        
        ' 跳过空单元格
        If sheetName <> "" Then
            ' 尝试将名称加入集合，重复时会触发错误
            On Error Resume Next
            existingSheets.Add sheetName, Key:=sheetName
            On Error GoTo 0
            
            ' 没有错误说明是新名称，创建工作表
            If Err.Number = 0 Then
                ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = sheetName
            End If
        End If
    Next cell
End Sub

关键细节说明 #

• 去重逻辑：利用集合的Key唯一性，添加重复名称时会抛出错误，通过错误判断直接跳过重复项
• 空格处理：用Trim清除单元格值前后的空格，避免因空格导致的“假重复”
• 空值跳过：判断单元格非空，防止创建无效的空名称工作表
• 灵活调整：可以修改wsSource的工作表名、目标列（把"A"改成对应列标识）、遍历起始行（如果表头不在第1行）

注意事项 #

• 确保列中的值符合Excel工作表命名规则：不能包含/:*?"<>|字符，长度不超过31位
• 如果工作簿中已存在同名工作表，代码会直接跳过创建（和列内重复值逻辑一致）

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