Sub sort()
Dim rArea As Range, lRow As Long, oCN As Long
'Set this to the range of names
Set rArea = ActiveSheet.Range("C2:G4")
'Set this to output
outColumn = "J"

oCN = Columns(outColumn).Column
For Each cv In rArea
    lRow = ActiveSheet.Range(outColumn & ActiveSheet.Rows.Count).End(xlUp).Row
    Cells(lRow + 1, oCN).Value = cv.Value
    Cells(lRow + 1, oCN - 1).Value = Cells(cv.Row, 2).Value
Next cv

End Sub