Previous Topic Next Topic

Macro to copy/paste specific range every 3 rows

Solved/Closed
Isa - Jul 6, 2015 at 12:08 PM
 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
Related:

1 response

Answer 1 / 1
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Jul 7, 2015 at 11:56 AM
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
1
Isa
Jul 7, 2015 at 12:51 PM
Thank you so much, Trowa! The code works perfectly.

You just saved my day! :))

Best regards,
Isa
0