Extract Email Addresses

for all in one cell (A1) try this one:

Option Explicit

Sub ExtractMail()
    Dim aData
    Dim i As Long, lngrow As Long
    
    With ActiveSheet
        aData = Split(.Cells(1, 1).Value2, ",")
        lngrow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        For i = LBound(aData) To UBound(aData)
            If InStr(aData(i), "@") > 0 Then
                If InStr(aData(i), " ") > 0 Then
                    aData(i) = Right(aData(i), Len(aData(i)) - InStrRev(aData(i), " "))
                End If
                .Cells(lngrow, 1).Value2 = aData(i)
                lngrow = lngrow + 1
            End If
        Next i
        
    End With
    
End Sub