Excel VBA：将指定行迁移至其他工作表并仅粘贴值

问题描述 #

需要将「Users」工作表中第25列（Y列）值为「Closed」的行迁移至「Archive」工作表，且仅保留单元格的计算结果（值），不复制公式或多余格式。

优化后的可行代码 #

Sub MoveClosedRowsToArchive()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    ' 直接绑定源表和目标表，避免切换选中状态
    Set wsSource = ThisWorkbook.Worksheets("Users")
    Set wsTarget = ThisWorkbook.Worksheets("Archive")
    
    ' 获取源表Y列最后一行数据的行号
    lastRow = wsSource.Cells(wsSource.Rows.Count, "Y").End(xlUp).Row
    
    ' 倒序遍历行，防止删除行时跳过后续数据
    For i = lastRow To 1 Step -1
        If wsSource.Cells(i, "Y").Value = "Closed" Then
            ' 复制源行后，仅粘贴值和数字格式
            wsSource.Rows(i).Copy
            With wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1, 0)
                .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                Application.CutCopyMode = False ' 清除Excel的复制选中状态
            End With
            
            ' 删除源表中的目标行
            wsSource.Rows(i).Delete
        End If
    Next i
    
    ' 可选：定位到源表A2单元格
    wsSource.Range("A2").Select
End Sub

关键改进说明 #

• 取消Select/Activate操作：直接引用工作表对象，避免因手动切换工作表导致的代码报错，同时提升运行效率。
• 倒序遍历行：正序删除行时，下一行会自动上移，循环会跳过该行；倒序遍历可彻底避免这个问题，确保所有符合条件的行都被处理。
• 精准粘贴控制：xlPasteValuesAndNumberFormats确保仅粘贴单元格值和数字格式，若不需要保留数字格式，可替换为xlPasteValues。

更高效的替代方案（无需复制粘贴） #

如果追求极致运行速度，可以直接将源行的值赋值到目标行，省去复制粘贴的步骤：

Sub MoveClosedRowsToArchive_Fast()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRowSource As Long
    Dim lastRowTarget As Long
    Dim i As Long
    
    Set wsSource = ThisWorkbook.Worksheets("Users")
    Set wsTarget = ThisWorkbook.Worksheets("Archive")
    
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "Y").End(xlUp).Row
    
    For i = lastRowSource To 1 Step -1
        If wsSource.Cells(i, "Y").Value = "Closed" Then
            lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
            ' 直接将源行A-Y列的值赋值到目标行
            wsTarget.Range("A" & lastRowTarget & ":Y" & lastRowTarget).Value = wsSource.Range("A" & i & ":Y" & i).Value
            ' 删除源行
            wsSource.Rows(i).Delete
        End If
    Next i
    
    wsSource.Range("A2").Select
End Sub

原代码潜在问题 #

你的更新版本已使用PasteSpecial，但仍存在两个隐患：

1. 依赖Select/Activate操作，容易受用户手动操作干扰；
2. 正序遍历行，删除时会跳过部分符合条件的数据。

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