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

Question

我正在尝试创建VBA代码，将B列中的数据复制并粘贴到A列的正下方。我没有很好的VBA经验，所以我很难创建这样的代码。

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

例如，B3将被粘贴到A4中。 B5会被粘贴到A6中。 一直到列表完成为止。

感谢您的任何帮助！

Answer 1

这是一个简单的例子，可以满足您的要求。

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

根据您的数据的样子，您可能希望为“i”的值设置更动态的内容。

Answer 2

使用来自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

Answer 3

以下代码非常适合您的标准。

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