Menu
  1. Accueil
  2. Tech Forum
  3. Office Software
  4. Excel

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

Report
-
 Isa -
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

1 reply

Answer 1 / 1
Posts
2744
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
May 10, 2021
 461
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
Thank you
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Report

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

You just saved my day! :))

Best regards,
Isa
Ask a question

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!