Vba 将一系列单元格移动到活动工作表中的另一个位置

我正在尝试创建一个VBA宏，将黄色高亮单元格移动到绿色单元格，就像下图所示。我尝试使用偏移代码，但无法使其偏移一系列单元格，从A3-I3到J2-R2

信息行的数量可以是40到900行，所以我需要一些能够继续移动单元格直到A-I列中没有更多信息的东西

理想的结果是根据需要对任意多的行进行这样的反射

我对VBA的世界还是相当陌生的，并且已经为其他的提议创造了一些，但我似乎无法理解这一点

----2018年1月22日更新---

我用这些代码解决了这个问题。我将I设为4，因为前5行经常不需要移动。在我测试的时候发现了这个

Sub ()
Dim i As Long, lastRow As Long, rngToMove As Range

lastRow = Worksheets("cxl macro test").Cells(1048576, 1).End(xlUp).Row

For i = 4 To lastRow
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 10) = Worksheets("cxl macro test").Cells(i - 1, 1)
        Worksheets("cxl macro test").Cells(i - 1, 1) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 11) = Worksheets("cxl macro test").Cells(i - 1, 2)
        Worksheets("cxl macro test").Cells(i - 1, 2) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 12) = Worksheets("cxl macro test").Cells(i - 1, 3)
        Worksheets("cxl macro test").Cells(i - 1, 3) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 13) = Worksheets("cxl macro test").Cells(i - 1, 4)
        Worksheets("cxl macro test").Cells(i - 1, 4) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 14) = Worksheets("cxl macro test").Cells(i - 1, 5)
        Worksheets("cxl macro test").Cells(i - 1, 5) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 15) = Worksheets("cxl macro test").Cells(i - 1, 6)
        Worksheets("cxl macro test").Cells(i - 1, 6) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 16) = Worksheets("cxl macro test").Cells(i - 1, 7)
        Worksheets("cxl macro test").Cells(i - 1, 7) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 17) = Worksheets("cxl macro test").Cells(i - 1, 8)
        Worksheets("cxl macro test").Cells(i - 1, 8) = ""
    End If
    If Worksheets("cxl macro test").Cells(i, 1) = "" And Worksheets("cxl macro test").Cells(i - 3, 1) = "" Then
        Worksheets("cxl macro test").Cells(i - 2, 18) = Worksheets("cxl macro test").Cells(i - 1, 9)
        Worksheets("cxl macro test").Cells(i - 1, 9) = ""
    End If
Next i

尽管出于某种原因，我无法让它查看最后一行内容，也无法移动所需的行。物理数据的最后一行是526，但当我使用一个较小的示例，最后一行是70时，我得到了相同的结果

---

有人知道我该怎么做吗

我会在这里使用for循环

ur = Sheets(YourSheetName).UsedRange.Rows.Count
For Each rw In ur
If sheets(YourSheetname).Range("A" & ur+1).Value = "" Then
'YOUR COPY PASTE CODE HERE'
else
End If
Next rw

试试这个

Sub CopyCells()
    Dim i As Long, lastRow As Long, rngToMove As Range

    lastRow = Worksheets("Sheet1").Range("I" & Rows.Count).End(xlUp).Row

    For i = 1 To lastRow - 1 Step 3
        Set rngToMove = Range("A" & i + 1 & ":I" & i + 1)
        rngToMove.Cut Destination:=Range("J" & i)
    Next i
End Sub

假设：

• 数据从第1行开始，包含在A到I列中
• 有一个空白行分隔数据块

---

通过在经过调整的代码末尾添加+2解决了这一问题

lastRow=工作表（“cxl宏测试”）。单元格（Rows.Count，“A”）。结束（xlUp）。行+2

---

​谢谢大家的帮助

我实际上扩展了代码。看看原始帖子中的更新。我实际上扩展了代码。看看原始帖子中的更新。