VBA报错：Range类Select方法失败，求按列值复制行解决方案

错误原因分析 #

• 文本匹配错误：原代码判断条件写的是"Accruals"（带末尾s），但你实际要筛选的是"Accrual"，这会导致符合条件的行被全部跳过。
• 依赖激活/选择操作：Select方法失败大多因为工作表未处于前台激活状态，或是单元格被保护、不可选中。频繁切换激活工作表不仅容易触发错误，还会拖慢代码运行效率。
• 代码笔误：原代码里的ActivateSheet.PasteSpecial是拼写错误，正确应为ActiveSheet.PasteSpecial，但即便修正，依赖激活状态的写法依然不稳定。

优化后的稳定代码 #

直接通过工作表对象引用完成操作，完全避免激活和选择步骤：

Sub Coentunnel_Accruals()
    ' Coentunnel Macro
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRowSource As Long
    Dim lastRowTarget As Long
    Dim i As Long
    
    ' 预先定义工作表对象，减少重复引用
    Set wsSource = ThisWorkbook.Worksheets("Output for Exact")
    Set wsTarget = ThisWorkbook.Worksheets("Hard Output Accruals")
    
    ' 有效性检查逻辑保留
    If ThisWorkbook.Worksheets("Checks").Range("C2").Value > 0.01 Then
        MsgBox "One or multiple checks is/are invalid"
        Exit Sub
    End If
    
    ' 获取源表I列最后一行行号
    lastRowSource = wsSource.Cells(Rows.Count, 9).End(xlUp).Row
    
    ' 遍历源表行筛选目标数据
    For i = 2 To lastRowSource
        ' 修正匹配文本为"Accrual"
        If wsSource.Cells(i, 9).Value = "Accrual" Then
            ' 获取目标表最后一行行号
            lastRowTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row
            ' 直接复制值到目标位置，无需切换工作表
            wsSource.Rows(i).Copy
            wsTarget.Cells(lastRowTarget + 1, 1).PasteSpecial Paste:=xlPasteValues
        End If
    Next i
    
    Application.CutCopyMode = False
End Sub

大数据量场景优化写法 #

如果源表数据行数较多，逐行复制效率偏低，可以用数组一次性处理：

Sub Coentunnel_Accruals_Fast()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim sourceData As Variant
    Dim targetData As Variant
    Dim lastRowSource As Long
    Dim validRowCount As Long
    Dim i As Long, j As Long, k As Long
    
    Set wsSource = ThisWorkbook.Worksheets("Output for Exact")
    Set wsTarget = ThisWorkbook.Worksheets("Hard Output Accruals")
    
    If ThisWorkbook.Worksheets("Checks").Range("C2").Value > 0.01 Then
        MsgBox "One or multiple checks is/are invalid"
        Exit Sub
    End If
    
    lastRowSource = wsSource.Cells(Rows.Count, 9).End(xlUp).Row
    ' 把源表A到W列数据读取到数组
    sourceData = wsSource.Range("A2:W" & lastRowSource).Value
    
    ' 先统计符合条件的行数
    validRowCount = 0
    For i = 1 To UBound(sourceData)
        If sourceData(i, 9) = "Accrual" Then
            validRowCount = validRowCount + 1
        End If
    Next i
    
    ' 无符合条件数据则直接退出
    If validRowCount = 0 Then Exit Sub
    
    ' 初始化目标数组（A到W共23列）
    ReDim targetData(1 To validRowCount, 1 To 23)
    j = 1
    ' 筛选并复制数据到目标数组
    For i = 1 To UBound(sourceData)
        If sourceData(i, 9) = "Accrual" Then
            For k = 1 To 23
                targetData(j, k) = sourceData(i, k)
            Next k
            j = j + 1
        End If
    Next i
    
    ' 将数组一次性写入目标表
    lastRowTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row
    wsTarget.Range("A" & lastRowTarget + 1).Resize(validRowCount, 23).Value = targetData
End Sub

核心改进点 #

• 用Worksheet对象变量替代重复的Worksheets("xxx")调用，代码更简洁且不易出错。
• 彻底移除Activate和Select操作，从根源避免Select method failed错误。
• 修正了文本匹配的拼写错误，确保能精准筛选目标行。
• 高效写法通过数组读写数据，比逐行复制速度提升数倍，适合大数据量场景。

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