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

Sub ffffffffff()
 Dim lastR, i&, counter&, arrN(), mRng As Range, cC As Range
    With ActiveSheet
    lastR = .Cells(Rows.Count, "B").End(xlUp).Row
    For i = 1 To lastR
        counter = 0
        Set mRng = Range(Cells(i, 2), _
            .Cells(i, Columns.Count)). _
                SpecialCells(xlCellTypeConstants, xlNumbers)
            ReDim arrN(1 To mRng.Cells.Count)
            For Each cC In mRng
                counter = counter + 1
                arrN(counter) = cC.Value
            Next
        .Cells(i, 1).Value = Join(arrN, "")
        .Cells(i, 1).NumberFormat = "0"
    Next 'i
    End With
End Sub

Sub aaaaCARAULaaa()
 Dim i&, counter&, arrNum(), mRng As Range, cC As Range
    Application.ScreenUpdating = False
        Set mRng = Columns(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, cC.Column + 1). _
                        Resize(1, UBound(arrNum)).Value = arrNum
            Next
   Application.ScreenUpdating = True
End Sub