VBA循环处理CC编号时删除空工作表报错求助

你遇到的subWS.Delete报错，大概率是因为试图删除当前处于激活状态的工作表，或是dataRG的判断逻辑未覆盖到“仅表头无数据”的场景。下面直接给你修正方案：

核心修改点 #

• 删除工作表前，先切换到其他已存在的工作表（比如源数据工作表），避免删除激活表
• 优化空数据判断逻辑，覆盖“筛选后仅存表头”的情况
• 临时关闭删除警告，避免弹窗干扰循环执行

修正后的代码片段 #

' 先定义源数据工作表（替换成你的实际表名）
Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.Worksheets("源数据")

' 假设你的CC编号数组是这样的（替换成你的实际数组）
Dim ccList As Variant
ccList = Array("CC001", "CC002", "CC003")
Dim currentCC As Variant

For Each currentCC In ccList
    ' 新建工作表
    Dim subWS As Worksheet
    Set subWS = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    subWS.Name = currentCC
    
    ' 筛选源数据中对应CC编号的行
    wsSource.Range("A1").AutoFilter Field:=2 ' 把Field值换成CC编号所在的列号
    wsSource.Range("A1").AutoFilter Field:=2, Criteria1:=currentCC
    
    ' 获取筛选后的可见数据区域
    Dim dataRG As Range
    On Error Resume Next
    Set dataRG = wsSource.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 判断是否无有效数据（包括无可见区域、仅表头两种情况）
    If dataRG Is Nothing Or dataRG.Rows.Count = 1 Then
        ' 先切换到源表，避免删除当前激活的新表
        wsSource.Activate
        ' 关闭删除警告，执行删除后恢复
        Application.DisplayAlerts = False
        subWS.Delete
        Application.DisplayAlerts = True
        ' 跳过后续生成透视表的步骤，进入下一个循环
        GoTo NextCC
    End If
    
    ' 以下是你复制数据、生成透视表的原有代码...

NextCC:
Next currentCC

关键说明 #

1. 避免删除激活表：新建工作表后默认会成为激活表，直接删除会触发VBA报错，所以先切换到源表再执行删除操作。
2. 覆盖空数据场景：如果筛选后只有表头（dataRG.Rows.Count = 1），也属于无有效数据的情况，需要删除工作表。
3. 错误处理捕获可见区域：用On Error Resume Next处理SpecialCells找不到可见区域的情况，确保dataRG能正确赋值为Nothing。
4. 临时关闭警告：Application.DisplayAlerts = False可以跳过删除工作表时的确认弹窗，执行完删除后立即恢复，不影响后续操作。

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