VBA实现Sheet1到Sheet2可变区域复制粘贴并逐行偏移避免覆盖

问题分析 #

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

• 未指定工作表的Range引用可能导致错误（比如当前激活表不是Sheet1时，Range("A4")会指向激活表的单元格）
• 固定粘贴到A3，无法实现自动偏移到上次粘贴的下一行

解决方案 #

修改后的代码会自动定位Sheet2的最后非空行，将Sheet1的目标区域粘贴到下一行：

Sub CopyDataToSheet2()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim lastRowSource As Long
    Dim lastColSource As Long
    Dim nextRowTarget As Long
    
    ' 定义工作表对象，避免激活/切换表
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set targetSheet = ThisWorkbook.Sheets("Sheet2")
    
    ' 获取Sheet1中A4开始的有效数据区域的最后一行和最后一列
    lastRowSource = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    lastColSource = sourceSheet.Cells(4, sourceSheet.Columns.Count).End(xlToLeft).Column
    
    ' 确保A4下方有数据
    If lastRowSource >= 4 Then
        Set sourceRange = sourceSheet.Range(sourceSheet.Cells(4, 1), sourceSheet.Cells(lastRowSource, lastColSource))
        
        ' 获取Sheet2中A列的最后非空行，下一行就是粘贴起始位置
        nextRowTarget = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
        
        ' 复制数据到目标位置
        sourceRange.Copy targetSheet.Cells(nextRowTarget, 1)
    End If
End Sub

关键说明 #

• 指定工作表对象：用sourceSheet和targetSheet明确引用工作表，避免因当前激活表变化导致的错误
• 获取最后有效行/列：
  • sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row：从A列底部向上找最后非空行，比End(xlDown)更可靠（避免中间有空行的情况）
  • sourceSheet.Cells(4, sourceSheet.Columns.Count).End(xlToLeft).Column：从第4行最右侧向左找最后非空列
• 自动定位粘贴位置：nextRowTarget计算Sheet2 A列最后非空行的下一行，确保每次粘贴都不会覆盖已有数据

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