How to copy a row N number of times in the same column in Excel?

Question

We are not able to create a formula which will copy 200 rows of a column in a same order and paste it multiple times in the same column and in the same order.

Example: columns A1:A200 have names in a particular order and we want to repeat the same order in the same column for 3000 times.

What is the way to do it without manual dragging?

Answer 1

Multi-Stack a Range Vertically

Sub VMultiStackTEST()

    Const SourceRangeAddress As String = "A1:A200"
    Const DestinationFirstCellAddress As String = "A1"
    Const StackCount As Long = 3000

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim srg As Range: Set srg = ws.Range(SourceRangeAddress)
    Dim dfCell As Range: Set dfCell = ws.Range(DestinationFirstCellAddress)
    
    VMultiStack srg, dfCell, StackCount
    
    ' or (instead) just e.g.:
    'VMultiStack Range("A1:A200"), Range("A1"), 3000

End Sub

Sub VMultiStack( _
        ByVal SourceRange As Range, _
        ByVal DestinationFirstCell As Range, _
        Optional ByVal StackCount As Long = 1)
    Const ProcName As String = "VMultiStack"
    On Error GoTo ClearError
 
    Dim IsSuccess As Boolean
 
    Dim sData As Variant
    Dim srCount As Long
    Dim cCount As Long
    Dim sAddress As String
    
    With SourceRange.Areas(1)
        sAddress = .Address(0, 0)
        srCount = .Rows.Count
        cCount = .Columns.Count
        If srCount + cCount = 2 Then
            ReDim sData(1 To 1, 1 To 1): sData(1, 1) = .Value
        Else
            sData = .Value
        End If
    End With
    
    Dim dData As Variant: ReDim dData(1 To srCount * StackCount, 1 To cCount)
    
    Dim n As Long
    Dim sr As Long
    Dim dr As Long
    Dim c As Long
    
    For n = 1 To StackCount
        For sr = 1 To srCount
            dr = dr + 1
            For c = 1 To cCount
                dData(dr, c) = sData(sr, c)
            Next c
        Next sr
    Next n
    
    Dim dAddress As String
    
    With DestinationFirstCell.Resize(, cCount)
        With .Resize(dr)
            .Value = dData
            dAddress = .Address(0, 0)
        End With
        .Resize(.Worksheet.Rows.Count - .Row - dr + 1).Offset(dr).Clear
    End With
    
    IsSuccess = True
    
ProcExit:
    If IsSuccess Then
        MsgBox "Stacked '" & sAddress & "' " & StackCount & " times to '" _
            & dAddress & "'.", _
            vbInformation, ProcName
    Else
        If Len(sAddress) > 0 Then
            MsgBox "Could not stack '" & sAddress & "' " & StackCount _
                & " times. No action taken.", _
                vbExclamation, ProcName
        Else
            MsgBox "The program failed.", vbCritical, ProcName
        End If
    End If

    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub