Вырезать и вставить диапазон ячеек в выбранное место назначения

Question

Я хочу вырезать и вставить диапазон ячеек (например, от A2: D2 до B1: E1) и затем повторить этот процесс для 692 строк.

Я пытался сделать это в макросах, но безуспешно.

Sub cut_paste() 
    Dim nr As Integer 
    For nr = 1 To 692 
        Range("A" & nr).Select 
        Selection.Cut 
        Range("B" & nr).Select 
        ActiveSheet.Paste 
        Range("B" & nr).Select 
        Selection.Cut 
        Range("C" & nr).Select 
        ActiveSheet.Paste 
        Range("C" & nr).Select 
        Selection.Cut 
        Range("D" & nr).Select 
        ActiveSheet.Paste 
        Range("D" & nr).Select 
        Selection.Cut 
        Range("E" & nr).Select 
        ActiveSheet.Paste 
    Next nr 
End Sub

ОШИБКА 4001

Answer 1

Попробуйте:

Option Explicit

Sub test()

    Dim Lastrow As Long, i As Long

    With ThisWorkbook.Sheets("Sheet1")

        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 3 To Lastrow Step 2
            .Range("A" & i & ":D" & i).Cut .Range("B" & i - 1 & ":E" & i - 1)
        Next i

    End With

End Sub

Answer 2

Сначала вы создаете цикл для строк со 2 по 692:

For i = 2 to 692
    'code to execute in the loop goes here
Next i

Затем в этом цикле вы выполняете копирование / вставку

For i = 2 to 692
    Sheet1.Range("A" & i & ":D" & i).Copy Destination:=Sheet1.Range("B" & i - 1 & ":E" & i - 1)
Next i