使用高级筛选拆分数据至新工作表时遇运行时错误1004求助

你遇到的运行时错误'1004'：提取范围存在缺失或无效的字段名，主要是因为代码里的范围引用没有明确指定工作表，还有几个潜在的细节问题。下面是修正后的代码，以及对应的问题说明：

错误原因分析 #

• 未指定工作表的范围引用：Range("AA1")和读取唯一值的Range([AA2],...)默认指向当前激活的工作表，而非数据所在的"Filter This"表，导致高级筛选无法找到正确的目标区域。
• 潜在的工作表命名非法字符：如果C列的唯一值包含Excel禁止的字符（如/ \ * ? : [ ]），创建新工作表时会触发额外错误。
• 未清理旧数据：如果AA列之前有残留数据，会导致筛选出的唯一值不准确。

修正后的VBA代码 #

Sub FilterToSheets()
    Application.ScreenUpdating = False
    Dim x As Range
    Dim rng As Range
    Dim last As Long
    Dim sht As Worksheet
    Dim uniqueValsRng As Range
    Dim newSheetName As String
    
    ' 指定数据所在工作表
    Set sht = ThisWorkbook.Sheets("Filter This")
    ' 获取C列最后一行行号
    last = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row
    ' 定义数据总范围（包含表头）
    Set rng = sht.Range("A1:H" & last)
    
    ' 先清理AA列旧数据（避免干扰）
    sht.Range("AA:AA").ClearContents
    
    ' 高级筛选提取C列唯一值到AA列（明确指定目标范围属于sht表）
    sht.Range("C1:C" & last).AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=sht.Range("AA1"), _
        Unique:=True
    
    ' 定义唯一值的范围（从AA2开始，明确属于sht表）
    Set uniqueValsRng = sht.Range(sht.Range("AA2"), sht.Cells(sht.Rows.Count, "AA").End(xlUp))
    
    ' 遍历每个唯一值
    For Each x In uniqueValsRng
        ' 处理工作表名称的非法字符
        newSheetName = Replace(Replace(Replace(Replace(Replace(Replace(x.Value, "/", "-"), "\", "-"), "*", "-"), "?", "-"), ":", "-"), "[", "-")
        newSheetName = Replace(newSheetName, "]", "-")
        
        ' 检查工作表是否已存在（避免重复创建报错）
        On Error Resume Next
        Dim existingSheet As Worksheet
        Set existingSheet = ThisWorkbook.Sheets(newSheetName)
        If Err.Number <> 0 Then
            ' 不存在则新建工作表
            Set existingSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            existingSheet.Name = newSheetName
        End If
        On Error GoTo 0
        
        ' 筛选并复制数据
        rng.AutoFilter Field:=3, Criteria1:=x.Value
        ' 复制可见区域到新工作表
        rng.SpecialCells(xlCellTypeVisible).Copy existingSheet.Range("A1")
    Next x
    
    ' 关闭筛选
    sht.AutoFilterMode = False
    
    ' 恢复Excel设置
    With Application
        .ScreenUpdating = True
        .CutCopyMode = False
    End With
End Sub

关键修正点说明 #

1. 明确指定工作表：所有范围引用都加上sht.前缀，确保操作的是数据所在的工作表，避免激活表切换导致的错误。
2. 清理旧数据：在高级筛选前清空AA列，防止之前的残留数据影响唯一值的提取。
3. 处理非法工作表名称：替换掉Excel不允许的字符，避免创建工作表时报错。
4. 检查工作表是否存在：避免重复创建同名工作表导致的错误。

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