Excel宏数据复制异常：仅复制首尾记录问题咨询

核心问题 #

宏仅复制首尾两条记录的根源在于范围选择逻辑错误：当数据行内存在空白单元格时，Range(Status.End(xlToLeft), Status.End(xlToRight))会因遇到空白提前停止，无法选中完整的目标数据范围；同时原粘贴位置的判断逻辑存在潜在的空白行误判风险。

修复后的代码 #

Sub CopyOverBudgetRecords()
    Dim StatusCol As Range
    Dim Status As Range
    Dim PasteCell As Range

    Set StatusCol = Sheet7.Range("E1:E14")
    
    For Each Status In StatusCol
        ' 定位目标工作表的最后一行空白单元格（兼容中间空白行的可靠方式）
        Set PasteCell = Sheet37.Cells(Sheet37.Rows.Count, "A").End(xlUp).Offset(1, 0)
        ' 初始状态下直接从A2开始粘贴
        If Sheet37.Range("A2").Value = "" Then Set PasteCell = Sheet37.Range("A2")
        
        ' 状态匹配时复制固定列范围（A-E），避免空白干扰
        If Status.Value = "Hukamnama" Then
            Status.Offset(0, -4).Resize(1, 5).Copy PasteCell
        End If
    Next Status
End Sub

关键调整说明 #

• 替换范围选择逻辑：放弃依赖End(xlToLeft/xlToRight)的动态范围，改用Offset(0, -4).Resize(1, 5)直接选中状态列（E列）向左4列的A列开始、共5列的固定范围，彻底规避行内空白导致的范围缺失。
• 优化粘贴位置判断：使用Sheet37.Cells(Sheet37.Rows.Count, "A").End(xlUp).Offset(1, 0)定位目标表最后一行，即使A列存在空白行也能准确找到下一个粘贴位置，解决原逻辑可能跳错行的问题。
• 明确值判断：将Status = "Hukamnama"改为Status.Value = "Hukamnama"，消除对象引用的潜在歧义。

动态范围扩展建议 #

如果后续数据列范围可能变化，可改用以下代码动态获取当前行的完整有效数据范围（需确保每行有效数据连续无中断空白）：

' 动态获取当前行从第一个非空到最后一个非空的完整范围
Dim DataRange As Range
Set DataRange = Status.CurrentRegion.Rows(Status.Row - Status.CurrentRegion.Row + 1)
DataRange.Copy PasteCell

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