Sub ArrayToRows1()
Dim MyArray()
Dim Rows As Long
Rows = 5200
ReDim MyArray(1 To Rows)
Cells.Clear
i = 1
For r = 1 To Rows
MyArray(r) = i
i = i + 1
Next r
Range(Cells(1, 1), Cells(Rows, 1)) = _
Application.Transpose(MyArray)
End Sub