Разделение содержимого 1й ячейки на много в столбец в excel

for i = 1 to len([A1])
   Cells(i+1, 1) = mid([A1], i, 1)
next

For c = 1 To 10000
  For i = 1 To Len(Cells(c))
   Cells(i + 1, c) = Mid(Cells(i), i, c)
  Next
Next

Dim mRng As Range, cC As Range
    Set mRng = Rows(1). _
            SpecialCells(xlCellTypeConstants, xlNumbers)
    mRng.Select
    For Each cC In mRng
        For i = 1 To Len([A1])
            Cells(i + 1, cC.Column) = Mid([A1], i, 1)
        Next 'i
    Next

Cells(i + 1, c) = Mid(Cells(i), i, 1)

    For Each cC In mRng
        For i = 1 To Len(Cstr(сС.value))
            Cells(i + 1, cC.Column) = Mid(сС.value, i, 1)
        Next 'i
    Next

Sub asdfs()
Dim mRng As Range, cC As Range, i&, a&
    Set mRng = Rows(1). _
            SpecialCells(xlCellTypeConstants, xlNumbers)
    For Each cC In mRng
        cC.Select
        a = Len(CStr(cC.Value))
        For i = 1 To Len(CStr(cC.Value))
            Cells(i + 1, cC.Column) = Mid(cC.Value, i, 1)
        Next 'i
    Next
End Sub

Cells(i + 1, c) = Mid(Cells(c), i, 1)

Sub next_asdfs()
Dim mRng As Range, cC As Range, i&, arrNum()
    Set mRng = Rows(1). _
            SpecialCells(xlCellTypeConstants, xlNumbers)
    For Each cC In mRng
        ReDim arrNum(1 To Len(CStr(cC.Value)))
        For i = 1 To Len(CStr(cC.Value))
            arrNum(i) = CLng(Mid(cC.Value, i, 1))
        Next 'i
        Cells(cC.Row + 1, cC.Column). _
                    Resize(UBound(arrNum), 1).Value = _
                                    Application.Transpose(arrNum)
    Next
End Sub