将单元格复制并粘贴到VBA循环下方的行中

我正在尝试创buildVBA代码，将列B中的数据复制并粘贴到A列正下方的行中。我对VBA没有太多的经验，所以我正在努力创build这样的代码。

我想创build一个代码，循环显示列A和B中的整个数据集，如附图所示。

例如，B3会粘贴到A4。 B5会粘贴到A6。 一路下来，直到名单完成。

感谢您的任何帮助！

Answer 1

以下代码适用于您的标准。

 rowNum = 3 Do While Trim(Range("A" & rowNum).Value) <> "" Range("A" & (rowNum + 1)).Value = Range("B" & rowNum).Value rowNum = rowNum + 2 Loop 

Answer 2

这是一个简单的例子，将会做你所要求的。

 For i = 2 To 10 If Range("A" & i) > "" And Range("A" & i + 1) = "" Then Range("B" & i).Cut Range("A" & i + 1).Select ActiveSheet.Paste Application.CutCopyMode = False Else End If Next 

取决于你的数据是什么样的，你可能会想为“我”的值设置一些更dynamic的东西。

Answer 3

使用来自https://stackoverflow.com/a/71296/42346的 LastRowIndex查找最后一行，然后迭代第2列中的行，将第1列中的值放在当前行的下一行。

 Sub iterate() Dim r As Long Dim c As Long Dim endrow As Long c = 2 endrow = LastRowIndex(ActiveSheet, c) For r = 2 To endrow Step 1 If ActiveSheet.Cells(r, c).Value <> "" Then ActiveSheet.Cells(r + 1, c - 1).Value = ActiveSheet.Cells(r, c).Value End If Next r End Sub Function LastRowIndex(ByVal w As Worksheet, ByVal col As Variant) As Long Dim r As Range Set r = Application.Intersect(w.UsedRange, w.Columns(col)) If Not r Is Nothing Then Set r = r.Cells(r.Cells.Count) If IsEmpty(r.Value) Then LastRowIndex = r.End(xlUp).Row Else LastRowIndex = r.Row End If End If End Function