Sub s()
a = [b6]
b = [b8]
n = Len(a)
ReDim arr(1 To n)
For i = 1 To n
arr(i) = Mid(a, i, 1) & Mid(b, i, 1)
Next
For i = 1 To n - 1
For j = n - 1 To i Step -1
If arr(j) > arr(j + 1) Then
t = arr(j)
arr(j) = arr(j + 1)
arr(j + 1) = t
End If
Next
Next
[b10].Resize(n) = Application.Transpose(arr)
End Sub