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