Try the following modified macro

'--------------------------------
Sub move_names(
Dim tmp As Singl
With Selection.CurrentRegion.Columns(1
If .Cells.Count = 3 The
For tmp = .Cells.Count To 3 Step -
If Asc(Left(.Cells(tmp - 1).Value, 1)) < Asc(Left(.Cells(tmp).Value, 1)) And InStr(Trim(.Cells(tmp - 1).Value), " ") = 0 The
.Cells(tmp - 2).Value = .Cells(tmp - 2).Value & " " & .Cells(tmp - 1).Valu
.Cells(tmp - 1).EntireRow.Delet
End I
Nex
End I
End Wit
End Su
'---------------------------------------------

Regards
Edwin Ta

http://www.vonixx.co