Copy / Paste data based on values in adjacent column

Question

Hi I am new to VBA and have hit a wall. Tried piecing together snippets of code with the little I understand but think I am over my head. I would greatly appreciate any help constructing a block of code to achieve the following goal:

In the following worksheet

1. I am trying to loop through column A and identify any blank cells.

2. If the cells are blank I would like to copy the values in the range of 4 cells adjacent to the right of the blank cell in column A. For example: if loop identified A2 as blank cell then the loop would copy the values in range("B2:E2")

3. From here I would like to paste the values below the copied range to only the rows that are not blank in column A. For example: The loop would identify not blank rows in column A as ("A3:A9") and paste data below the copied range to range ("B3:E9")

4. The loop would stop at the next blank row in column and restart the process

Here is a screen shot of the data:

Here is what I have so far, sorry its not much Thanks in advance!

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

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

Answer 2

Your code only needs a few tweaks (plus the PasteSpecial!) to get it to work:

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 3

I cannot make much sense of what you want, it seems to contradict itself. But, since I highly doubt anyone else is going to help you with this (per the rules), I'll give you a much better start.

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