Repeat range Nth times-CodePudding

I am trying to devise a code that enables me to repeat a range (of one column) to be repeated Nth times. This is my try (and it is working) but I need your ideas to improve the code if possible

Sub Test()
    Const N As Integer = 3
    Dim a, i As Long, ii As Long, k As Long
    a = ActiveSheet.Range("A1:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim b(1 To UBound(a, 1) * N, 1 To 1)
    For i = 1 To N
        For ii = LBound(a, 1) To UBound(a, 1)
            k = k   1
            b(k, 1) = a(ii, 1)
        Next ii
    Next i
    Range("C1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

CodePudding user response：

I would do it similarly...

Sub Test()
    Dim a, c&, i&, k&
    
    Const n& = 3
    
    a = [a1].Resize(Cells(Rows.Count, 1).End(xlUp).Row)
        ReDim b(1 To n * UBound(a), 1 To 1)
        
        For k = 1 To n
            For i = 1 To UBound(a)
                c = c   1
                b(c, 1) = a(i, 1)
            Next
        Next
    [c1].Resize(UBound(b)) = b
    
End Sub

But it would be best to make it into an encapsulated procedure...

Sub Test()
    CloneRange [a1], [c1], 3
End Sub

Sub CloneRange(rSrc As Range, rDst As Range, Optional n& = 1)
    Dim a, c&, i&, k&        
    a = rSrc.Resize(Cells(Rows.Count, 1).End(xlUp).Row)
        ReDim b(1 To n * UBound(a), 1 To 1)
        For k = 1 To n
            For i = 1 To UBound(a)
                c = c   1
                b(c, 1) = a(i, 1)
            Next
        Next
    rDst.Resize(UBound(b)) = b
End Sub