Paste array to range paste only the first value

I am trying to paste Array values into a range but it does only paste in range the first value.

Dim Array1()

For i = 0 to 9
   ReDim Preserve Array1
   Array1(i)= Int((6 * Rnd) + 1)
Next

ws.Range("A1").Value = Array1

output :

Am I doing wrong something ?

>Solution :

You have to redimension the array correctly and then transpose it.

Option Explicit

Sub Sample()
    Dim Array1()
    Dim ws As Worksheet
    Dim i As Long
    
    '~~> Change to respective sheet
    Set ws = Sheet1

    For i = 0 To 9
        ReDim Preserve Array1(i) '<~~ increment by i
        Array1(i) = Int((6 * Rnd) + 1)
    Next
    
    '~~> Store in the worksheet
    ws.Range("A1").Resize(UBound(Array1) + 1, 1).Value = Application.Transpose(Array1)
End Sub