Excel宏异常：交替行复制至空白行时出现数据覆盖问题

问题描述 #

我有一个Excel宏，用于处理每行数据后跟随空白行的表格，功能是将数据行的部分内容剪切至下方空白行。宏通过检查特定单元格，若该单元格满足条件则剪切指定列（第16至25列）数据到下一行对应列（第6至15列）。但运行时前若干行可正常执行，后续会出现剪切空白单元格并覆盖有效数据的问题。

该宏原本是更大宏的一部分，插入空白行功能正常，为排查问题将其拆分为独立步骤，还保存为CSV清除格式后测试，但问题依旧。尝试调整IsEmpty判断条件（If与If Not）均未解决，不同长度数据集也存在此问题，MsgBox仅用于逐行调试。

原宏代码：

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
'

Dim iCounter As Long
Dim LastRowColumnB As Long, NewLastRow As Long
    LastRowColumnB = Cells(Rows.Count, 2).End(xlUp).Row
    NewLastRow = LastRowColumnB + LastRowColumnB
    Dim MyRange As Range, NewRange As Range
    Set MyRange = Range("B2:B" & LastRowColumnB)
    Set NewRange = Range("B2:B" & NewLastRow)
 With ActiveSheet
        For Each Row In NewRange
            If IsEmpty(Row.Cells(10)) Then
                Range(Cells(Row.Row, 16), Cells(Row.Row, 25)).Cut Destination:=Range(Cells(Row.Row + 1, 6), Cells(Row.Row + 1, 15))
            End If
            MsgBox ("Pause")
        Next Row
    End With
    
End Sub

问题分析与修复方案 #

核心问题 #

1. 遍历范围错误：NewRange设置为原行数的两倍，导致遍历到无数据或已处理的行，触发错误剪切。
2. 判断逻辑颠倒：当前代码检查空白行的J列是否为空，完全不符合需求——应该检查数据行的特定单元格来决定是否剪切。
3. 无明确工作表绑定：Cells和Range未指定所属工作表，可能导致跨表引用错误。

修复后的代码 #

Sub FixMacro1()
'
' 修复后的宏：将数据行指定列剪切到下方空白行
' Keyboard Shortcut: Ctrl+Shift+Q
'

Dim lastRow As Long
Dim i As Long

' 获取B列最后一行数据行
lastRow = Cells(Rows.Count, 2).End(xlUp).Row

' 按数据行+空白行的规律遍历（步长2）
With ActiveSheet
    For i = 2 To lastRow Step 2
        ' 检查数据行的J列（第10列）是否非空，可根据实际需求调整判断条件
        If Not IsEmpty(.Cells(i, 10)) Then
            ' 剪切当前行16-25列到下一行空白行的6-15列
            .Range(.Cells(i, 16), .Cells(i, 25)).Cut Destination:=.Range(.Cells(i + 1, 6), .Cells(i + 1, 15))
        End If
        ' MsgBox ("Pause") ' 调试用，可按需保留或注释
    Next i
End With
End Sub

修改说明 #

• 精准遍历：利用数据行和空白行的交替规律，以步长2遍历数据行，避免处理无效行。
• 逻辑修正：改为检查数据行的目标单元格，确保只对符合条件的数据行执行剪切。
• 明确工作表引用：所有单元格和范围都绑定到ActiveSheet，避免引用混乱。
• 简化代码：去掉不必要的变量，让逻辑更清晰。

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