基于单元格内容的Excel工作表复制删除VBA代码优化需求

核心改进思路 #

1. 新增工作表存在性检查逻辑，避免重复创建报错；
2. 对比C列名称列表与现有工作表，自动清理已移除的对应工作表（保护核心数据源表和模板表不被误删）。

修改后的完整VBA代码 #

Sub RectangleRoundedCorners6_Click()
    Dim shTemplate As Worksheet
    Dim shSource As Worksheet
    Dim cell As Range
    Dim wsName As String
    Dim existingWs As Worksheet
    Dim nameList As Collection
    
    ' 绑定核心工作表
    Set shTemplate = Sheets("6.1")
    Set shSource = Sheets("6")
    
    ' 收集C列C8及以下的有效工作表名称（自动去重）
    Set nameList = New Collection
    On Error Resume Next
    For Each cell In shSource.Range("C8:C" & shSource.Cells(Rows.Count, "C").End(xlUp).Row)
        wsName = Trim(cell.Value)
        If wsName <> "" Then
            nameList.Add wsName, Key:=wsName
        End If
    Next cell
    On Error GoTo 0
    
    ' 需求1：仅创建不存在的工作表
    For Each cell In shSource.Range("C8:C" & shSource.Cells(Rows.Count, "C").End(xlUp).Row)
        wsName = Trim(cell.Value)
        If wsName <> "" And Not WorksheetExists(wsName) Then
            shTemplate.Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = wsName
        End If
    Next cell
    
    ' 需求2：删除不在C列列表中的工作表（排除核心表）
    Application.DisplayAlerts = False
    For Each existingWs In ThisWorkbook.Sheets
        wsName = existingWs.Name
        If wsName <> shSource.Name And wsName <> shTemplate.Name Then
            Dim isInList As Boolean
            isInList = False
            For Each item In nameList
                If item = wsName Then
                    isInList = True
                    Exit For
                End If
            Next item
            If Not isInList Then existingWs.Delete
        End If
    Next existingWs
    Application.DisplayAlerts = True
End Sub

' 辅助函数：判断指定名称的工作表是否存在
Function WorksheetExists(wsName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(wsName)
    On Error GoTo 0
    WorksheetExists = Not ws Is Nothing
End Function

关键细节说明 #

• 报错规避：通过WorksheetExists函数捕获工作表引用错误，直接判断目标表是否存在，彻底避免1004命名冲突报错；
• 空值与重复处理：跳过C列空单元格，用Collection的Key属性自动过滤重复名称，避免无效操作；
• 安全删除：关闭删除弹窗提示，同时强制排除"6"（数据源表）和"6.1"（模板表），确保核心工作表不被误删。

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