Copy range x times

[luisvv93]

Hello Team,

I am working on a little project and trying to copy a range, x amount of times. This is what I have:

Sub Export()

Application.ScreenUpdating = False

Dim LastColumn As Long

Dim x, y As Integer
Dim ProRng As Range
x = 2

LastColumn = Cells(7, Columns.Count).End(xlToLeft).Offset(0, -6).Column 'Calculates number of times I want to copy the range

For Each Cell In Range("G7", Range("G7").End(xlToRight)) 'Range I want to copy is in row 7 and It goes from G7 to the last cell with data at the right in row 7 
    For y = 1 To LastColumn
        Sheets("rawdata").Range("B" & x).Value = Cell.Value 'Need to start copying in cell B2
        x = x + 1
    Next y
Next Cell

    Application.ScreenUpdating = True
    
End Sub

So "LastColumn" is the number of times I want to copy the range.

The range can vary all the time so I just made it automatically with xlToRight. However for example I have the following:

G7	H7	I7
E2VA17	E2VA16	E2VA14

and the code just does this:

E2VA17
E2VA17
E2VA17
E2VA16
E2VA16
E2VA16
E2VA14
E2VA14
E2VA14

Its kinds good however I need it pasted it like this(lets say that LastColumn = 3, it should copy the range 3 times):

E2VA17
E2VA16
E2VA14
E2VA17
E2VA16
E2VA14
E2VA17
E2VA16
E2VA14


I really would appreciate any kind of help.

Regards,
Luis V.

[Akuini]

Try this:

Sub Export()

Dim c As Range, r As Range, x As Long
Application.ScreenUpdating = False

    Set r = Range("G7", Range("G7").End(xlToRight))
    x = r.Columns.count
    Set c = Sheets("rawdata").Range("B2").Resize(x)
    c = Application.Transpose(r)
    c.Copy c.Resize(x * x)

Application.ScreenUpdating = True
    
End Sub

[luisvv93]

Hi Akuini,

Thanks for your reply, it worked awesome, however I failed with my calculation because I actually needed to use "LastRow" instead of "LastColumn" as the number of times I want to copy and paste the range.

 LastRow = Range("A" & Rows.Count).End(xlUp).Offset(-8, 0).Row

If I change x in your code it mess it all Can you help me with that?

I tried but failed:

Sub Export()

Dim c As Range, r As Range, x As Long
Dim LastRow As Long

Application.ScreenUpdating = False

LastRow = Range("A" & Rows.Count).End(xlUp).Offset(-8, 0).Row

    Set r = Range("G7", Range("G7").End(xlToRight))
    x = LastRow 
    Set c = Sheets("rawdata").Range("B2").Resize(x)
    c = Application.Transpose(r)
    c.Copy c.Resize(x * x)

Application.ScreenUpdating = True
    
End Sub

Thanks in advance.

[Akuini]

Not sure I understand.
Let's say the last row with data in col A is row 10, do you mean you want to copy the range 2 times?
Try this:

Sub Export2()

Dim c As Range, r As Range, x As Long
Dim LastRow As Long

Application.ScreenUpdating = False

LastRow = Range("A" & Rows.count).End(xlUp).Offset(-8, 0).Row

    Set r = Range("G7", Range("G7").End(xlToRight))
    x = r.Columns.count
    Set c = Sheets("rawdata").Range("B2").Resize(x)
    c = Application.Transpose(r)
    c.Copy c.Resize(x * LastRow)

Application.ScreenUpdating = True
    
End Sub