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

Question

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

Report

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

Macro to copy/paste specific range every 3 rows
Excel macro for copy & paste selected range ✓ - Forum - Programming
MACRO to copy / paste cell text down various rows ✓ - Forum - Excel
Excel - A macro to copy/paste a selected range - How-To - Excel
Macro copy and paste in next blank cell ✓ - Forum - Excel
Excel macro copy and paste data from one workbook to another - How-To - Excel

1 reply

Ask a question

TrowaD · Accepted Answer · 2015-07-07T11:56:13-0400

Answer 1 / 1

TrowaD

Posts: 2670
Registration date: Sunday September 12, 2010
Status: Moderator
Last seen: October 22, 2020

446
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

Report

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

Your reply