如何实现交叉式数据复制？现有VBA代码输出结果异常求助

原代码未匹配“两行有值、一行空行”的分组规律，导致复制逻辑错误。以下是修正后的代码，完全匹配你的数据排列需求：

Sub Copy_by_crossing()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    
    Set ws = ThisWorkbook.ActiveSheet
    lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    
    ' 按3行一组循环（数据行1、数据行2、空行）
    For i = 2 To lastRow Step 3
        ' 把第i+1行的A-D复制到第i行的E-H
        ws.Range("E" & i).Resize(, 4).Value = ws.Range("A" & i + 1, "D" & i + 1).Value
        ' 把第i行的A-D复制到第i+2行的E-H
        ws.Range("E" & i + 2).Resize(, 4).Value = ws.Range("A" & i, "D" & i).Value
    Next i
End Sub

关键说明 #

• 用Step 3实现每3行一组的循环，精准匹配“两行数据+一行空行”的结构
• 明确指定源范围和目标范围，避免原代码中依赖E列空值判断的不确定性
• 循环起始从行2开始（对应你的数据起始行），自动处理所有符合规律的分组

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