Sub Macro1()
Dim i As Long, Arr(), LastRow As Long, x As Long, ii As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Arr = Range(Cells(1, 1), Cells(LastRow, 2)).Value
    For i = 1 To UBound(Arr)
        For ii = 1 To Len(Arr(i, 1))
            x = x + CInt(Mid(Arr(i, 1), ii, 1))
            Arr(i, 2) = x
        Next
        x = 0
    Next
    Range("A1").Resize(UBound(Arr), 2).Value = Arr
End Sub

Sub Main()
Dim i As Long
    For i = 1 To Range("B2").Value
        Call Макрос1
    Next
End Sub