复制单元格未始终粘贴到目标工作表顶部的VBA代码问题排查

尝试将Test1工作表中K列值为"1"的行移动到Test2工作表，但粘贴位置经常不连续——本该从顶部开始粘贴，却有时从A384行开始。当前使用的VBA代码如下：

Dim Num As Range
Dim xCell2 As Range
Dim X As Long
Dim Y As Long
Dim Z As Long
X = Worksheets("Test1").UsedRange.Rows.Count
Y = Worksheets("Test2").UsedRange.Rows.Count
If Y = 1 Then
   If Application.WorksheetFunction.CountA(Worksheets("Test2").UsedRange) = 0 Then Y = 0
End If
Set Num = Worksheets("Test1").Range("K:K" & L)
On Error Resume Next
Application.ScreenUpdating = False
For Z = 1 To Num.Count
    If CStr(Num(Z).Value) = "1" Then
        Num(Z).EntireRow.Copy Destination:=Worksheets("Test2").Range("A" & Y + 1)
        Num(Z).EntireRow.Delete
        If CStr(Num(Z).Value) = "1" Then
            Z = Z - 1
        End If
        Y = Y + 1
    End If
Next
Application.ScreenUpdating = True

问题根源 #

1. UsedRange不可靠：UsedRange.Rows.Count会包含工作表中曾经编辑过的空白区域，哪怕内容已删除，仍会将这些区域计入，导致Test2的起始粘贴行错误。
2. 未定义变量L：代码中Range("K:K" & L)的L未声明赋值，属于语法错误，会导致Num范围定义异常。
3. 正向循环删除行的索引混乱：正向循环时删除行，后续行会上移，导致索引错位，可能漏处理或重复处理行。

修正后的代码 #

Sub MoveRowsToTest2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long
    Dim z As Long
    
    ' 定义工作表对象，避免重复调用Worksheets
    Set ws1 = ThisWorkbook.Worksheets("Test1")
    Set ws2 = ThisWorkbook.Worksheets("Test2")
    
    Application.ScreenUpdating = False
    
    ' 获取Test1的最后一行（K列）
    lastRow1 = ws1.Cells(ws1.Rows.Count, "K").End(xlUp).Row
    ' 获取Test2的最后一行（A列），确保从真实的下一行开始粘贴
    lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    ' 如果Test2为空，设置lastRow2为0
    If lastRow2 = 1 And ws2.Cells(1, "A").Value = "" Then lastRow2 = 0
    
    ' 从后往前循环，避免删除行导致的索引错位
    For z = lastRow1 To 1 Step -1
        If CStr(ws1.Cells(z, "K").Value) = "1" Then
            ' 移动行到Test2的下一行
            ws1.Rows(z).Copy Destination:=ws2.Range("A" & lastRow2 + 1)
            ws1.Rows(z).Delete
            lastRow2 = lastRow2 + 1
        End If
    Next z
    
    Application.ScreenUpdating = True
End Sub

关键改动说明 #

• 替换UsedRange为End(xlUp)：通过Cells(Rows.Count, "A").End(xlUp).Row准确获取Test2的最后一行，彻底避免空白区域干扰，确保从顶部（或真实最后一行的下一行）开始粘贴。
• 修正未定义变量问题：直接通过lastRow1定义Test1的K列有效行数，避免原代码中L的未定义错误。
• 反向循环删除行：从最后一行往第一行循环，删除行不会影响未处理的行索引，避免漏行或重复处理。
• 使用工作表对象：提前定义ws1和ws2，减少重复调用Worksheets，提升代码效率和可读性。
• 移除不必要的On Error Resume Next：避免隐藏代码中的潜在错误，方便后续调试。

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