VBA循环复制数据至工作簿时末尾出现多余空白行求助

为什么会出现末尾空白行？ #

你代码里用Range("A:A").SpecialCells(xlCellTypeLastCell).Row获取最后一行的方法存在缺陷：xlCellTypeLastCell依赖Excel的「已使用区域」（UsedRange）判断，这个区域不会自动收缩——如果工作表之前有过数据行，即使后来删除了内容，它依然会把那个位置认定为最后一行，导致计算出的findLastRow比实际需要的大1，粘贴后就会多出空白行。

正确获取最后一行的方法 #

改用从列A底部往上查找第一个非空单元格的方式，这是VBA中获取真实数据最后一行的标准写法：

findLastRow = Range("A" & Rows.Count).End(xlUp).Row + 1

如果A列可能完全为空，再加个兜底判断：

With Workbooks("Agent Stats Monthly.xlsm").ActiveSheet
    findLastRow = IIf(.Range("A1").Value = "", 1, .Range("A" & .Rows.Count).End(xlUp).Row + 1)
End With

优化后的完整代码 #

另外，原代码里的Activate和Select完全没必要，还容易引发切换错误，直接引用工作簿和工作表对象更稳定：

Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim i As Integer
Dim findLastRow As Long

' 提前定义源/目标工作表，避免反复切换激活
Set wsSource = Workbooks("Agent.xlsx").ActiveSheet
Set wsTarget = Workbooks("Agent Stats Monthly.xlsm").ActiveSheet

i = 5
For Each agentRow In wsSource.Range("A4:A45")
    ' 检查代理活跃状态
    If wsSource.Range("D" & i).Value > 10 And wsSource.Range("E" & i).Value > 10 Then
        ' 复制指定单元格区域
        wsSource.Range("A" & i & ", D" & i & ":R" & i & ", U" & i & ":Z" & i).Copy
        
        ' 获取目标工作表的真实最后一行
        findLastRow = wsTarget.Range("A" & wsTarget.Rows.Count).End(xlUp).Row + 1
        ' 处理A列全空的特殊情况
        If findLastRow = 2 And wsTarget.Range("A1").Value = "" Then findLastRow = 1
        
        ' 粘贴数据
        wsTarget.Range("A" & findLastRow).PasteSpecial
    End If
    i = i + 1
Next agentRow

' 释放对象变量
Set wsSource = Nothing
Set wsTarget = Nothing

额外注意事项 #

• 尽量不要用ActiveSheet，如果知道具体工作表名称，直接写成Workbooks("Agent.xlsx").Sheets("你的表名")，能避免因工作表切换引发的错误。
• 循环里i从5开始对应Range("A4:A45")的逻辑没问题，但后续修改源数据范围时，要同步调整i的初始值。
• 如果只需要粘贴数据值，可改用PasteSpecial xlPasteValues，避免复制格式带来的额外问题。

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