VBA跨工作簿复制并筛选指定列求助（下标越界错误）

嘿，我来帮你搞定这个VBA的问题！你遇到的「Subscript out of range」大概率是因为工作簿/工作表引用不明确，加上AutoFilter的语法没写对，还有跨工作簿复制的逻辑没理顺。咱们一步步来修正：

常见错误原因分析 #

• 直接引用了未打开或名称错误的工作簿/工作表，导致下标越界
• AutoFilter的Field参数填错（比如把C列写成2，实际应该是3，从A列开始计数）
• 筛选后没有正确获取可见区域，或者复制范围没处理好
• 没有清除之前的筛选状态，导致筛选结果不符合预期

修正后的完整代码 #

Sub CopyFilteredMaryData()
    Dim sourceWB As Workbook
    Dim targetWB As Workbook
    Dim sourceWS As Worksheet
    Dim targetWS As Worksheet
    Dim lastRow As Long
    Dim filteredRange As Range
    
    ' 1. 确认源/目标工作簿是否已打开（替换成你的实际工作簿名称）
    On Error Resume Next
    Set sourceWB = Workbooks("SourceData.xlsx") ' 源数据工作簿名
    Set targetWB = Workbooks("TargetData.xlsx") ' 目标工作簿名
    On Error GoTo 0
    
    ' 检查工作簿是否存在，不存在则提示并退出
    If sourceWB Is Nothing Then
        MsgBox "源工作簿未打开，请先打开SourceData.xlsx！"
        Exit Sub
    End If
    If targetWB Is Nothing Then
        MsgBox "目标工作簿未打开，请先打开TargetData.xlsx！"
        Exit Sub
    End If
    
    ' 2. 指定具体工作表（替换成你的实际工作表名）
    Set sourceWS = sourceWB.Worksheets("Sheet1") ' 源数据所在工作表
    Set targetWS = targetWB.Worksheets("Sheet1") ' 目标数据所在工作表
    
    ' 清除源工作表的旧筛选，避免干扰新筛选
    If sourceWS.AutoFilterMode Then sourceWS.AutoFilterMode = False
    
    ' 3. 获取源数据最后一行，确定筛选范围
    lastRow = sourceWS.Cells(sourceWS.Rows.Count, "C").End(xlUp).Row
    
    ' 4. 正确执行AutoFilter：筛选C列（第3列）包含"Mary"的数据
    sourceWS.Range("A1:C" & lastRow).AutoFilter _
        Field:=3, _
        Criteria1:="*Mary*", _
        Operator:=xlFilterValues
    
    ' 5. 获取筛选后的可见数据区域（从第2行开始，排除表头）
    On Error Resume Next
    Set filteredRange = sourceWS.Range("A2:C" & lastRow).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 6. 复制筛选结果到目标工作簿
    If Not filteredRange Is Nothing Then
        ' 找到目标工作表的第一个空行
        Dim targetLastRow As Long
        targetLastRow = targetWS.Cells(targetWS.Rows.Count, "A").End(xlUp).Row + 1
        
        ' 直接复制到目标位置，避免手动粘贴的麻烦
        filteredRange.Copy Destination:=targetWS.Cells(targetLastRow, "A")
        
        ' 清除剪贴板，释放资源
        Application.CutCopyMode = False
        MsgBox "包含Mary的筛选数据已成功复制！"
    Else
        MsgBox "没有找到包含Mary的数据哦！"
    End If
    
    ' 最后清除源工作表的筛选状态，恢复原始视图
    sourceWS.AutoFilterMode = False
End Sub

关键修正点说明 #

• 解决下标越界：通过On Error Resume Next检查工作簿是否存在，避免直接引用不存在的对象；明确指定工作表名称，不要依赖默认索引（比如Sheets(1)容易因为工作表顺序变化出错）
• AutoFilter语法修正：Field:=3对应C列（从A列开始计数），Criteria1:="*Mary*"是模糊匹配（包含Mary的所有内容），Operator:=xlFilterValues确保筛选逻辑生效；先清除旧筛选，避免残留筛选影响结果
• 跨工作簿复制优化：用SpecialCells(xlCellTypeVisible)精准获取筛选后的可见区域，再找到目标工作表的空行进行粘贴，不会覆盖已有数据；用Copy Destination直接指定目标位置，比先复制再粘贴更高效
• 错误处理增强：增加了筛选结果为空的判断，避免无匹配数据时触发报错

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