Ms Excel copy and paste data duplicate by x

I've Data A table in Microsoft Excel.

What I want to do is to copy the content in that data and paste it multiply by X.

Let say X is 3.

The actual X number is huge, so automation is really needed here instead of copy and paste it hundreds times.

enter image description here


Few helper value along with INDIRECT worksheet function solves the issue:

Situation 1:

enter image description here

How it works:

  • Put desire value in cell G2, indicates that how may times you want to repeat set of data.
  • Row counter formula in cell G3:

=COUNTA(F2:F4)*G2

  • Final formula in cell H2:

    =IF(ROW(H2)>G$3+1,"",IF(ISBLANK(INDIRECT("F"&ROW(F2))),INDIRECT("H"&(ROWS($F$2:F2)-(COUNTA(F:F)-2))),F2))
    

N.B.

  • Fill formula down till few extra rows.

Situation 2:

enter image description here

N.B.

  • As soon you change value in cell G2, to repeat set of data n times, the formula will adjust result in column H.
  • You may adjust cell references in the formula as needed.

You can try this code. Link to a button on the page, it assumes input is from A2 down and output will go from C2 down on sheet1 (change to suit).

Sub Duplicate()
Application.ScreenUpdating = False

Dim ws As Worksheet: Set ws = Sheet1
Dim MyCRnge As Range, c As Range
Dim MyX As String
Dim MyArr() As Variant
Dim i As Long, x As Long

Set MyCRnge = ws.Range(ws.Cells(2, 1), ws.Cells(ws.Cells(2, 1).End(xlDown).Row, 1))

MyX = InputBox("Give me a number", "My Duplicator")
If Not IsNumeric(MyX) Then Exit Sub
MyX = CLng(MyX)

ReDim MyArr(MyX * MyCRnge.Rows.Count)
x = 1
For i = LBound(MyArr) To UBound(MyArr) - 1

    MyArr(i) = MyCRnge(x, 1)
    If x = MyCRnge.Rows.Count Then
    x = 1
    Else
    x = x + 1
    End If

Next i

ws.Range(ws.Cells(2, 3), ws.Cells((MyX * MyCRnge.Rows.Count) + 1, 3)) = Application.Transpose(MyArr)

End Sub