根據相鄰列中的值復制/粘貼數據

Question

嗨，我是VBA的新手，碰壁了。 嘗試將代碼片段與我所了解的很少的內容拼湊在一起，但我覺得自己不勝其煩。 我非常感謝構建代碼塊以實現以下目標的任何幫助：

在以下工作表中

1. 我試圖遍歷A列並標識任何空白單元格。

2. 如果單元格為空白，我想復制與A列中空白單元格右側相鄰的4個單元格范圍內的值。例如：如果循環將A2標識為空白單元格，則循環將復制range（ “ B2：E2”）

3. 從這里，我想將復制范圍以下的值僅粘貼到A列中非空白的行。例如：循環將A列中的非空白行標識為（“ A3：A9”），並將數據粘貼至下面復制的范圍到范圍（“ B3：E9”）

4. 循環將在列中的下一個空白行處停止並重新啟動該過程

這是數據的屏幕截圖：

這是我到目前為止的內容，對不起，謝謝。

Sub select_blank()

For Each Cell In Range(ActiveCell, ActiveCell.End(xlDown))
    If IsEmpty(ActiveCell.Value) = True Then
        ActiveCell.Offset(, 1).Resize(, 5).copy
    End If
Next
End Sub

Answer 1

您的代碼只需要進行一些調整（加上PasteSpecial ！）就可以正常工作：

Sub select_blank()
    Dim cel As Range
    With ActiveSheet
        'specify that the range to be processed is from row 2 to the
        'last used cell in column A
        For Each cel In .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
            If IsEmpty(cel.Value) Then
                'If the cell is empty, copy columns B:F
                cel.Offset(, 1).Resize(, 5).Copy
            Else
                'If the cell is not empty, paste the values previously copied
                'NOTE: This relies on cell A2 being empty!!
                cel.Offset(, 1).PasteSpecial
            End If
        Next
    End With
    Application.CutCopyMode = False
End Sub

Answer 2

我無法完全理解您想要的東西，它似乎與自己矛盾。 但是，由於我非常懷疑還有其他人會（按照規則）為您提供幫助，因此我將為您提供更好的開始。

Sub Test()
  Dim nRow As Integer

  nRow = 1

  Do Until Range("A" & nRow) = "" And Range("A" & nRow + 1) = ""
    If Range("A" & nRow) = "" Then
    ' do stuff here in the loop

    End If
    nRow = nRow + 1
  Loop

End Sub

Answer 3

Sub copyRange()
    Dim rngDB As Range, vDB, rng As Range

    Set rngDB = Range("a2", Range("a" & Rows.Count).End(xlUp))
    For Each rng In rngDB
        If rng = "" Then
            vDB = rng.Offset(, 1).Resize(1, 4)
        Else
            rng.Offset(, 1).Resize(1, 4) = vDB
        End If
    Next rng

End Sub