Excel VBA复制粘贴异常求助：数据未按预期归档

问题背景 #

需实现每日将Sorts工作表的C2:Hn区域数据，追加到Sorts Archive工作表的B-G列（从现有数据下一行开始），但原代码无法达成预期效果。

工作表说明 #

• 源表（Sorts）："Door"在B1单元格，数据范围为C2到H列最后一行
• 目标表（Sorts Archive）：需将数据粘贴到B-G列，实现每日数据累积
• 预期效果：数据逐行追加，无覆盖，形成完整的历史归档

原代码问题 #

Sub EOS_Archive_2()
Dim LCopyRow As Long
Dim LDistRow As Long
 
LCopyRow = Worksheets("Sorts").Cells(Sheet2.Rows.Count, 1).End(xlUp).Row
    
LDistRow = Worksheets("Sorts Archive").Cells(Sheet10.Rows.Count, 1).End(xlUp).Row + 1
 
Worksheets("Sorts").Range("C2: H" & LCopyRow).Copy _
Destination:=Worksheets("Sorts Archive").Range("B" & LDistRow)
 
End Sub

原代码存在3个核心问题：

1. 混合使用工作表名称与代码名（Worksheets("Sorts")和Sheet2），易因表名/代码名变更引发引用错误
2. 依赖A列判断源表最后一行，若A列无数据或最后行与C-H列数据行不一致，会导致复制范围错误
3. 依赖A列判断目标表最后一行，若Sorts Archive的A列无数据，会导致每次粘贴都从第2行开始，覆盖原有数据

修正后的代码 #

Sub EOS_Archive_2()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRowSource As Long
    Dim lastRowDest As Long
    
    ' 绑定工作表对象，避免引用混乱
    Set wsSource = ThisWorkbook.Worksheets("Sorts")
    Set wsDest = ThisWorkbook.Worksheets("Sorts Archive")
    
    ' 基于源表数据起始列（C列）确定最后一行
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
    ' 基于目标表粘贴起始列（B列）确定最后一行
    lastRowDest = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Row
    
    ' 处理目标表为空的情况，确保从第2行开始粘贴
    If lastRowDest < 2 Then
        lastRowDest = 2
    Else
        lastRowDest = lastRowDest + 1
    End If
    
    ' 复制数据到目标区域
    wsSource.Range("C2:H" & lastRowSource).Copy _
        Destination:=wsDest.Range("B" & lastRowDest)
End Sub

关键优化点 #

• 使用工作表对象绑定，彻底避免名称/代码名混用的风险
• 源表最后一行基于C列（数据实际起始列）判断，确保获取真实的最后数据行
• 目标表最后一行基于B列（粘贴起始列）判断，同时处理空表场景，保证数据正确追加
• 逻辑清晰，后续维护更方便

可选优化（按需使用） #

• 若需考虑C-H列中最靠下的数据行（比如某行C列空但H列有数据），替换最后行判断代码：

  lastRowSource = wsSource.Range("C:H").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  

• 若仅需复制值（无需格式、公式），改用更高效的赋值方式：

  wsDest.Range("B" & lastRowDest).Resize(lastRowSource - 1, 6).Value = wsSource.Range("C2:H" & lastRowSource).Value
  

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