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
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
See more 

2 replies

Best answer
TrowaD 2395 Posts Sunday September 12, 2010Registration date July 17, 2018 Last seen - Jul 7, 2015 at 11:56 AM
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

Thank you so much, Trowa! The code works perfectly.

You just saved my day! :))

Best regards,
Isa