Excel VBA批量移动指定行至EOL工作表问题求助

原脚本核心问题 #

• 变量拼写错误：SouceSheet 应为 SourceSheet，导致原工作表引用出错
• 行跟踪逻辑失效：依赖ActiveCell.Row的TargetRow与rng.Rows遍历无关联，删除行后行号偏移，引发遍历混乱
• 正向遍历删行缺陷：删除行后后续行自动上移，会跳过下一行的处理
• 选中范围处理不当：多选单元格时未统一转换为整行范围，导致遍历不完整

修正后的脚本（批量收集待删行方案） #

Sub MoveRows()
    Call SpeedUp
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    Dim LastRow As Long
    Dim rng As Range
    Dim deleteRows As Range
    Dim row As Range
    
    ' 统一将选中范围转换为整行，避免单个单元格选中的情况
    Set rng = Selection.EntireRow
    Set SourceSheet = ActiveSheet
    Set TargetSheet = ActiveWorkbook.Sheets("EOL")
    
    ' 获取EOL工作表的最后一行（从D列判断）
    LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "D").End(xlUp).Row + 1
    
    ' 遍历选中行：跳过隐藏行，复制内容并收集待删行
    For Each row In rng.Rows
        If Not row.Hidden Then
            ' 复制原行内容到EOL表
            row.Copy
            TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormulasAndNumberFormats
            TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormats
            LastRow = LastRow + 1
            
            ' 收集需要删除的行
            If deleteRows Is Nothing Then
                Set deleteRows = row
            Else
                Set deleteRows = Union(deleteRows, row)
            End If
        End If
    Next row
    
    ' 批量删除收集到的行，彻底避免逐行删除的索引错乱问题
    If Not deleteRows Is Nothing Then
        deleteRows.Delete
    End If
    
    Call SpeedDown
End Sub

关键优化点 #

• 统一选中范围：用Selection.EntireRow确保无论选中单元格还是整行，都以整行为单位处理
• 批量删除逻辑：先收集所有需删除的非隐藏行，最后一次性删除，解决删除行后索引偏移的核心问题
• 直接遍历行对象：不再依赖TargetRow，直接使用row对象操作当前行，避免关联错误
• 修复变量拼写：修正SouceSheet为SourceSheet，确保工作表引用正确

替代方案（反向遍历） #

如果不想收集待删行，也可以采用从后往前遍历的方式，规避删除行后的索引错乱：

Sub MoveRows_Reverse()
    Call SpeedUp
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    Dim LastRow As Long
    Dim rng As Range
    Dim i As Long
    
    Set rng = Selection.EntireRow
    Set SourceSheet = ActiveSheet
    Set TargetSheet = ActiveWorkbook.Sheets("EOL")
    
    LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "D").End(xlUp).Row + 1
    
    ' 从最后一行往前遍历，避免删行后索引偏移
    For i = rng.Rows.Count To 1 Step -1
        Set row = rng.Rows(i)
        If Not row.Hidden Then
            row.Copy
            TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormulasAndNumberFormats
            TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormats
            LastRow = LastRow + 1
            row.Delete
        End If
    Next i
    
    Call SpeedDown
End Sub

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