Sub aa()
Dim Arr, i#, j%,k#, S$
Dim By() As String
k = [a65536].End(xlUp).Row
ReDim By(1 To k)
Arr = Range("A1:A" & k)
By(k) = Arr(k, 1)
For i = k - 1 To 1 Step -1
S = S & " "
For j = 1 To Len(Arr(i, 1))
By(i) = By(i) & S & Mid(Arr(i, 1), j, 1)
Next
By(i) = LTrim(By(i))
Next
[B1].Resize(k, 1) = Application.Transpose(By)
End Sub
function Str(sVal as string) as string
dim i as long
str=mid(sVal,1,1)
for i=2 to len(sVal)
str=str & Space(int(Len(A1)*(15-i)/5)) & mid(sVal,i,1)
next
end function