根据相邻列中的值复制/粘贴数据

嗨，我是新来的VBA，并已经打了一堵墙。 试着拼凑一些代码片段，我知道，但我认为我是在我的头上。 我将不胜感激构build一个代码块来实现以下目标的任何帮助：

在下面的工作表中

1. 我试图循环通过列A，并确定任何空白单元格。

2. 如果单元格是空白的，我想复制在列A中空白单元格右边的4个单元格范围内的值。例如：如果循环将A2标识为空单元格，则循环将复制范围内的值（ “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