Macro to copy/paste specific range every 3 rows [Solved/Closed]

Question

Ask a question Report

Macro to copy/paste specific range every 3 rows [Solved/Closed]

Isa - Jul 6, 2015 at 12:08 PM - Latest reply: Isa

- Jul 7, 2015 at 12:51 PM

Excel Ask a question Report

Hello,

I am beginner in VBA and now have an Excel sheet with about 4000 rows, where I could need a macro.

I already recorded a macro for the first rows, which looks as follow:

Sub Loop1()

Range("BG2:FJ2").Select
Selection.Cut
Range("E3").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=39
Range("BG3:DH3").Select
Selection.Cut
Range("E4").Select
ActiveSheet.Paste

Range("BG5:FJ5").Select
Selection.Cut
Range("E6").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll ToRight:=39
Range("BG6:DH6").Select
Selection.Cut
Range("E7").Select
ActiveSheet.Paste

End Sub

'Or alternatively for the first row
Sub Loop2()

Sheets("Worksheet1").Range("BG2:FJ2").Cut Sheets("Worksheet1").Range("E3") 
Sheets("Worksheet1").Range("BG3:DH3").Cut Sheets("Worksheet1").Range("E4")

End Sub

However, I do not know how to adjust it, so that Excel does the rest/loop until row 4000.

Any idea or help would be highly appreciated.

Thanks a lot in advance.

Best,
Isa

2 replies

Ask a question

Accepted Answer

1

Thank you

Hi Isa,

See if the following code works for you:

Sub RunMe()
Dim x As Integer
x = 2
Do
    Range(Cells(x, "BG"), Cells(x, "FJ")).Cut Sheets("Worksheet1").Cells(x + 1, "E")
    Range(Cells(x + 1, "BG"), Cells(x + 1, "DH")).Cut Sheets("Worksheet1").Cells(x + 2, "E")
    x = x + 3
Loop Until x > 4000
End Sub

Best regards,
Trowa

Thank you, TrowaD 1

Something to say? Add comment

CCM has helped 1683 users this month

Macro to copy/paste specific range every 3 rows [Solved/Closed]

Your reply