Sub GetTextFromClipboard()
    'No Library Reference required.
    
    Dim objClipBoard        As Object
    Dim lngCounter          As Long
    Dim a, c As Range, i&
 
    Set objClipBoard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    objClipBoard.GetFromClipboard
 
    For lngCounter = 1 To UBound(Application.ClipboardFormats)
        If Application.ClipboardFormats(lngCounter) = xlClipboardFormatText Then
            'MsgBox objClipBoard.GetText(lngCounter)
            a = Split(objClipBoard.GetText(lngCounter), vbNewLine)
        End If
    Next lngCounter
 
    Set objClipBoard = Nothing
    
    For Each c In Selection.Columns(1).Cells
        If c = c.MergeArea.Cells(1) Then
            If i <= UBound(a) Then c.Value = a(i): i = i + 1
        End If
    Next
End Sub

Function em(s As String)
    Dim v
    Const EML_PTRN = "[A-Z0-9._%-]+@[A-Z0-9.-]+\.[A-Z]{2,4}"
    'https://www.regular-expressions.info/email.html

    With CreateObject("vbscript.regexp")
        .Pattern = EML_PTRN
        .Global = True
        .IgnoreCase = True
        Set v = .Execute(s)
    End With
    em = v(0).Value
End Function

Function emAll(s As String)
    Dim v, x$, m
    Const EML_PTRN = "[A-Z0-9._%-]+@[A-Z0-9.-]+\.[A-Z]{2,4}"
    'https://www.regular-expressions.info/email.html

    With CreateObject("vbscript.regexp")
        .Pattern = EML_PTRN
        .Global = True
        .IgnoreCase = True
        Set v = .Execute(s)
    End With
    For Each m In v
    x = x & ", " & m
    Next
    emAll = Mid(x, 3)
End Function

Function bbb$(t$)    'тоже емайлы email
    With CreateObject("VBScript.RegExp"): .Pattern = "\w+@[,\w]+\.?(?:\w+)?\.\w+": bbb = .Execute(t)(0)
    End With
End Function