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?

CodePudding user response：

With Office 365, you can put this into a LET as follows:

=LET( a, A1:A200, mBy, 3000,
       r, ROWS( a ),
       s, r * mBy,
       INDEX( a, MOD(SEQUENCE( s,,0 ),r)   1 ) )

where a is the column of names and mBy is the multiple (3000).

If you want to simplify it:

= INDEX( A1:A200, MOD(SEQUENCE( ROWS(A1:A200) * 3000,,0 ),ROWS(A1:A200))   1 )

CodePudding user response：

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