```
Sub SortNames()
Dim limit As Long
Dim limit2 As Long
Dim c As Long
Columns(2).Insert shift:=xlToRight
Columns(2).Insert shift:=xlToRight
limit = Cells(Rows.Count, 1).End(xlUp).Row
With WorksheetFunction
For c = 1 To limit
If Len(Cells(c, 1)) - Len(.Substitute(Cells(c, 1), " ", "")) = 0 Then
Cells(c, 2) = Cells(c, 1)
End If
If Len(Cells(c, 1)) - Len(.Substitute(Cells(c, 1), " ", "")) = 1 Then
Cells(c, 2) = Cells(c, 1)
End If
If Len(Cells(c, 1)) - Len(.Substitute(Cells(c, 1), " ", "")) = 3 Then
If Mid(Cells(c, 1), .Find("@", .Substitute(Cells(c, 1), " ", "@", 1)) + 1, 1) = "&" Then
Cells(c, 2) = Left(Cells(c, 1), .Find(" ", Cells(c, 1))) & Right(Cells(c, 1), Len(Cells(c, 1)) - .Find("@", .Substitute(Cells(c, 1), " ", "@", 3)))
Cells(c, 3) = Right(Cells(c, 1), Len(Cells(c, 1)) - .Find("@", .Substitute(Cells(c, 1), " ", "@", 2)))
End If
End If
If Len(Cells(c, 1)) - Len(.Substitute(Cells(c, 1), " ", "")) = 4 Then
If Mid(Cells(c, 1), .Find("@", .Substitute(Cells(c, 1), " ", "@", 2)) + 1, 1) = "&" Then
Cells(c, 2) = Left(Cells(c, 1), .Find("@", .Substitute(Cells(c, 1), " ", "@", 2)) - 1)
Cells(c, 3) = Right(Cells(c, 1), Len(Cells(c, 1)) - .Find("@", .Substitute(Cells(c, 1), " ", "@", 3)))
Else: Cells(c, 2) = Cells(c, 1)
End If
End If
Next c
End With
limit = Cells(Rows.Count, 2).End(xlUp).Row + 1
limit2 = Cells(Rows.Count, 3).End(xlUp).Row
For c = 1 To limit2
If Cells(c, 3) <> "" Then
Cells(limit, 2) = Cells(c, 3)
limit = limit + 1
End If
Next c
Columns(3).Delete shift:=xlToLeft
End Sub
```