=ЕСЛИ(A2="";E2;A2)

Sub мяу()
    Dim arr, arr1(), odic As Object
    arr = Range("A1").CurrentRegion.Value
    k = UBound(arr, 2)
    Set odic = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(arr)
        If odic.exists(arr(i, k)) Then
            arr1 = odic.Item(arr(i, k))
        Else
            ReDim arr1(1 To 4)
        End If
        For ii = 1 To k - 1
            If Len(arr(i, ii)) Then
                Select Case True
                Case arr(1, ii) Like "Фамилия*"
                    If Len(arr1(1)) Then Else arr1(1) = arr(i, ii)
                Case arr(1, ii) Like "Имя*"
                    If Len(arr1(2)) Then Else arr1(2) = arr(i, ii)
                Case arr(1, ii) Like "Отчество*"
                    If Len(arr1(3)) Then Else arr1(3) = arr(i, ii)
                Case arr(1, ii) Like "Имэйл*"
                    If Len(arr1(4)) Then Else arr1(4) = arr(i, ii)
                End Select
                odic.Item(arr(i, k)) = arr1
            End If
        Next
    Next

    For i = 2 To UBound(arr)
        Cells(i, k + 1).Resize(, 4) = odic.Item(Cells(i, k).Value)
    Next
End Sub