I have the following code to sort column b in worksheet1 based on name which
works just fine however when it sorts it does not keep all the cells
together, how do I make it keep the cell together then sort column b?

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "B2:B5001"

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
Me.Cells(.Row, "A").Value =
WorksheetFunction.Max(Range("A1:A5001")) + 1
Me.Range("A:G").Sort key1:=Me.Range("B3"), header:=xlYes
End With
End If

ws_exit:
Application.EnableEvents = True

End Sub