Sub ArrayToRows2() Dim Rows As Long Dim MyArray() Rows = 65536 ReDim MyArray(1 To Rows, 0 To 0) Cells.Clear i = 1 For r = 1 To Rows MyArray(r, 0) = i i = i + 1 Next r Range(Cells(1, 1), Cells(Rows, 1)) = MyArray End Sub