VBA跨表复制单行报错：Method 'Range'对象方法失败求助

核心错误原因及修复点 #

• 未定义lastRow变量
  代码直接使用lastRow但未声明、未赋值，导致wsTo.Range("A" & lastRow)生成无效的Range地址，这是触发「Method 'Range' of object 'Worksheet' failed」的直接原因。需先计算目标表的最后非空行，确定粘贴起始位置：

  Dim lastRow As Long
  lastRow = wsTo.Cells(wsTo.Rows.Count, "A").End(xlUp).Row + 1 ' 取A列最后行+1，实现追加
  

• 错误使用ActiveCell.Row
  循环遍历MyCell时，ActiveCell是当前选中单元格，不一定和MyCell所在行一致，应改用MyCell.Row获取当前循环行的行号。

• 未声明MyRange变量
  代码中使用的MyRange未在开头声明，需补充Dim MyRange As Range，避免隐式变量引发的未知问题。

• 复制整行不符合需求
  需求是复制少量列数据，原代码的EntireRow.Copy会复制整行，需改为指定列（示例复制C、D、E三列）：

  wsFrom.Range("C" & MyCell.Row & ":E" & MyCell.Row).Copy wsTo.Range("A" & lastRow)
  

修正后的完整代码 #

Dim MyCell As Range, MyRange As Range, wsFrom As Worksheet, wsTo As Worksheet
Dim lastRow As Long

Set wsFrom = Sheets("Sheet 0")
Set MyRange = wsFrom.Range("C3:C2000")

For Each MyCell In MyRange
    If Len(MyCell.Value) > 0 Then
        If Not sheetExist(MyCell.Value) Then
            Set wsTo = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            wsTo.Name = MyCell.Value
        Else
            Set wsTo = Worksheets(MyCell.Value)
        End If
        
        ' 计算目标表A列最后非空行，+1实现追加
        lastRow = wsTo.Cells(wsTo.Rows.Count, "A").End(xlUp).Row + 1
        ' 复制指定列（示例为C、D、E列）到目标表
        wsFrom.Range("C" & MyCell.Row & ":E" & MyCell.Row).Copy wsTo.Range("A" & lastRow)
    End If
Next MyCell

Function sheetExist(sSheet As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ActiveWorkbook.Sheets(sSheet)
    On Error GoTo 0 ' 恢复错误处理
    sheetExist = Not (ws Is Nothing)
End Function

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