Excel VBA按单元格值复制行到新工作表报438错误求解

核心错误点 #

• 拼写错误：Application.WorkseetFunction 缺少字母h，正确写法为Application.WorksheetFunction
• 循环索引错误：遍历单元格时错误使用列标识O作为索引，你的循环变量为C，应该改为xRg(C)才能正确读取O列每行的内容
• 内置常量拼写错误：VBA内置常量的前缀是小写字母L，不是数字1，你写的x1Yes、x1CellTypeBlanks、x1ShiftUp全部错误，正确写法为xlYes、xlCellTypeBlanks、xlShiftUp
• 逻辑冗余：去重、删除空白行的逻辑放在了循环内部，每遍历一行就执行一次，完全没必要，放到循环外执行一次即可
• 错误捕获逻辑不合理：On Error Resume Next会吞掉所有报错，反而不利于排查问题，不需要全局开启

修正后完整代码 #

Sub CopyRowBasedOnCellValue()
    Dim xRg As Range
    Dim A As Long
    Dim B As Long
    Dim C As Long

    A = Worksheets("Initials").UsedRange.Rows.Count
    B = Worksheets("Finals").UsedRange.Rows.Count

    If B = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Finals").UsedRange) = 0 Then B = 0
    End If

    Set xRg = Worksheets("Initials").Range("O1:O" & A)

    Application.ScreenUpdating = False

    For C = 1 To xRg.Count
        If CStr(xRg(C).Value) = "proceed" Then
            xRg(C).EntireRow.Copy Destination:=Worksheets("Finals").Range("A" & B + 1)
            B = B + 1
        End If
    Next
    
    ' 循环结束后统一处理去重和空白行
    If B > 0 Then
        Worksheets("Finals").UsedRange.RemoveDuplicates Columns:=1, Header:=xlYes
        ' 仅删除空白行时临时开启错误捕获，避免无空白行时报错
        On Error Resume Next
        Worksheets("Finals").UsedRange.SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
        On Error GoTo 0
    End If

    Application.ScreenUpdating = True
End Sub

额外说明 #

如果不需要区分大小写匹配（比如Proceed、PROCEED都算符合条件），可以把判断条件改为If UCase(CStr(xRg(C).Value)) = "PROCEED" Then即可。

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