Разложить строку на символы

Public Sub Example()
a = Worksheets("Лист2").Cells(1, 1).Value
 
For i = 1 To Len(a)
    s = Mid(a, i, 1)
    k = Mid(a, i + 1, 1)
   
    Worksheets("Лист2").Cells(i + 1, 1).Value = s
    'Cells(i + 1, 1).Interior.ColorIndex = i + 5
    
Next i
End Sub

Public Sub Example()
Dim re As Object, i&, x
  If re Is Nothing Then
    Set re = CreateObject("vbscript.regexp")
    re.Global = True
    re.Pattern = "(\D+)(\d+)"
  End If
  i = 1
  For Each x In re.Execute(Worksheets("Лист2").Cells(1, 1).Value)
    i = i + 1
    Worksheets("Лист2").Cells(i, 1).Value = WorksheetFunction.Rept(x.submatches(0), x.submatches(1))
    Worksheets("Лист2").Cells(i, 1).Interior.ColorIndex = i + 5
  Next
End Sub

Public Sub Example()
Dim re As Object, i&, x, arColor()
  Set re = CreateObject("vbscript.regexp")
  re.Global = True
  re.Pattern = "(\D+)(\d+)"
  arColor = Array(rgbRed, rgbPink, rgbYellow)
  i = 1
  For Each x In re.Execute(Worksheets("Лист2").Cells(1, 1).Value)
    i = i + 1
    With Worksheets("Лист2").Cells(i, 1)
      .Value = WorksheetFunction.Rept(x.submatches(0), x.submatches(1))
      .Interior.Color = arColor(i Mod 3)
    End With
  Next
End Sub