Копировать и вставить ячейку в строку ниже VBA Loop

Question

Я пытаюсь создать код VBA, который копирует и вставляет данные из столбца B в строку непосредственно под столбцом A. У меня нет большого опыта работы с VBA, и поэтому я боюсь создайте такой код.

Я хотел бы создать код, который будет цитировать весь набор данных в столбцах 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 

В зависимости от ваших данных вы, вероятно, захотите установить что-то более динамичное для значения «i».

Answer 3

Используйте LastRowIndex от https://stackoverflow.com/a/71296/42346, чтобы найти окончательную строку, затем перебирайте строки в столбце 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