Ms Excel copy and paste data duplicate by x

Question

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.

Answer 1

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

Situation 1:

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:

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.

Answer 2

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