Hello -

I just threw some code together ... there are no error checks in case
the format is different. It will step through Column A from Row 1
until it finds an empty Row. The output will be put next to it in
Column D.

Sub extract()
Set lSheet = ThisWorkbook.Sheets("Sheet1")

Set lSEL = lSheet.Cells(1, 1)

Do While lSEL.Value < ""

' First Name

lPositionA = InStr(lSEL.Value, ",")

lFirstName = Trim(Mid(lSEL.Value, 1, lPositionA - 1))

' Skip Middle Name

lPositionA = InStr(lPositionA + 1, lSEL.Value, ",")
lPositionA = lPositionA + 1

' Last Name

lPositionB = InStr(lPositionA, lSEL.Value, ",")

lLastName = Trim(Mid(lSEL.Value, lPositionA, lPositionB -
lPositionA))

' Skip

lPositionA = InStr(lPositionB + 1, lSEL.Value, ",")
lPositionA = lPositionA + 1

' e-mail

lPositionB = InStr(lPositionA + 1, lSEL.Value, ",")

lEmail = Trim(Mid(lSEL.Value, lPositionA, lPositionB -
lPositionA))

' OUTPUT in Column E (= 5)

lSheet.Cells(lSEL.Row, 5).Value = lFirstName & " " & lLastName
& ", " & lEmail

Set lSEL = lSheet.Cells(lSEL.Row + 1, 1)
Loop
End Sub

Enjoy,
Joe