Option Explicit
Sub abc()
Dim a
a = [a1].CurrentRegion.Resize(, 2).Value
Call bsort(a, 1, UBound(a), 1, 2, 1)
[a1].Offset(, UBound(a, 2) + 1).Resize(UBound(a), UBound(a, 2)) = a
End Sub
Function bsort(a, first, last, left, right, key)
Dim i, j, k, t
For i = first To last - 1
For j = first To last + first - 1 - i
If StrComp(a(j, key), a(j + 1, key), vbTextCompare) = 1 Then
For k = left To right
t = a(j, k): a(j, k) = a(j + 1, k): a(j + 1, k) = t
Next
End If
Next
Next
End Function