Repeat Macro

[Bill Zarvalias]

Hello every one!

I need help to repeat a macro. Down you can see that I repeated it manually 3 times. Only two things change every time the macro is repeated:

• The second line (every time +5 rows from the previous macro, same range number)
• The third line from the bottom (were every time the number increases by one)

Sheets("DataBase").Select
Range("A2:E130").Select
Selection.Copy
Sheets("CopyHere").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N2:Y2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Salvation").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B2").Select
Sheets("DataBase").Select
Range("F2:J130").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CopyHere").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N2:Y2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Salvation").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("DataBase").Select
Range("K2:O130").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CopyHere").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N2:Y2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Salvation").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Is it possible to be repeated by 500 times?

thank you in advance!

[#2 · Accepted solution]

I suspect something along these lines:

Sub Demo()
    Dim lOffset As Long
    For lOffset = 0 To 500 Step 5
        Sheets("DataBase").Range("A2:E130").Offset(0, lOffset).Copy
        Sheets("CopyHere").Range("A3").PasteSpecial _
                Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Sheets("CopyHere").Range("N2:Y2").Copy
        Sheets("Salvation").Range("B" & Sheets("Salvation").Rows.Count).End(xlUp).Offset(1).PasteSpecial _
                Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next
End Sub

[#3]

Dear Jan Karel Pieterse,

I cant thank you enough! It worked!

Just for the record (to those who may find this post useful in the future) it only repeats the macro 100 times. But if you change:

For lOffset = 0 To 500 Step 5    

to

For lOffset = 0 To 2500 Step 5

You are ready to go! 

P.S

This macro was needed as a part of a research for my thesis (Heart Failure Patients - New diagnostic tools). When I compete it, I am going to reply to you back, because I am going to write your name on the thanks page of my thesis as a contributor to my research! Thank you again!

[#4]

You're welcome! And apologies about the wrong endpoint of the loop. I wish you success finishing your thesis!