Sub Macros()
Dim i As Long, r As Long, n As Variant
n = InputBox("Введите количество столбцов," & Chr(10) & "на которое разбить столбец А", _
              "Ввод количества столбцов", 6)
If n <> "" Then
Application.ScreenUpdating = False
Dim MyArray As Variant, CArray() As Long
r = Int(1 + Columns(1).End(xlDown).Row / n)
ReDim CArray(1 To r, 1 To n)
MyArray = Range("A1:A" & Columns(1).End(xlDown).Row).Value
For i = 1 To UBound(MyArray)
      CArray(Int((i + n - 1) / n), ((i - 1) Mod n) + 1) = MyArray(i, 1)
Next i
Range("A1:A" & Columns(1).End(xlDown).Row).ClearContents
Range("A1").Resize(r, n) = CArray()
Application.ScreenUpdating = True
End If
End Sub