Excel VBA宏：跨工作簿复制数据并清除旧数据报错求助

我正尝试将Workbook1的数据复制到Workbook2的对应位置，若数据已存在但位于错误行（如WIP行而非Paid行），需清除该行内容。目前已实现数据复制功能，但清除旧数据的代码报错（错误400或运行时错误1004），问题应该出在数据复制后Workbook1与Workbook2的单元格值对比逻辑上。现有代码如下：

Application.ScreenUpdating = False

'insert variables as objects
Dim wb As Workbook
Dim wsa As Worksheet
Dim rg As Range, rga As Range, rgc As Range

'set variables
Set wb = Workbooks.Open("Workbook2")
Set wsa = wb.Sheets("Sheet1")
Set rg = wsa.Range("B12")
Set rga = wsa.Range("B124")
Set rgc = wsa.Range("B125")

'Identifies the next available Row
rg.End(xlUp).Offset(1, 0).Select

'Pastes Data
ActiveSheet.Paste

If ActiveCell = rga Then
   rga.Resize("1, 9").Select
   Selection.ClearContents
   ElseIf ActiveCell = rgc Then
   rgc.Resize("1, 9").Select
   Selection.ClearContents
   End If

Application.ScreenUpdating = True

问题分析 #

1. Select/ActiveCell滥用：跨工作簿操作时依赖激活单元格，极易因上下文切换错误触发1004报错。
2. Resize参数错误：Resize需传入数值参数，Resize("1,9")的字符串写法不符合语法要求。
3. 对比逻辑偏差：ActiveCell = rga是对比单元格值而非判断位置，完全不符合"错误行清除"的需求逻辑。

修改后的代码 #

Application.ScreenUpdating = False

Dim wb As Workbook
Dim wsa As Worksheet
Dim targetRow As Range
Dim copiedData As Variant

' 指定目标工作簿和工作表
Set wb = Workbooks.Open("Workbook2")
Set wsa = wb.Sheets("Sheet1")

' 获取复制的数据（假设复制区域为当前选中范围）
copiedData = Selection.Value

' 找到B列下一个空行作为粘贴目标
Set targetRow = wsa.Range("B" & wsa.Cells(wsa.Rows.Count, "B").End(xlUp).Row + 1)

' 粘贴数据到目标行
targetRow.Resize(1, UBound(copiedData, 2)).Value = copiedData

' 检查错误行并清除匹配数据
Dim checkRows As Variant
checkRows = Array(wsa.Range("B124"), wsa.Range("B125")) ' 定义需要检查的错误行

Dim checkCell As Range
For Each checkCell In checkRows
    ' 对比复制数据的关键标识（这里取第一列的值）
    If checkCell.Value = copiedData(1, 1) Then
        checkCell.Resize(1, 9).ClearContents
        Exit For ' 找到匹配项后退出循环
    End If
Next checkCell

Application.ScreenUpdating = True

关键改进点 #

• 移除所有Select/ActiveCell操作，直接通过对象变量操作单元格，避免上下文错误。
• 修正Resize参数格式，使用数值而非字符串。
• 调整对比逻辑：先获取复制数据，再检查错误行是否包含该数据，匹配则清除对应行内容。
• 用数组批量处理检查行，代码更简洁高效。

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