Split Data in one cell into below rows

[Ctrl+s]

Greetings,

Can any one help on this below situation.

I have data in two Columns one Columns contains data with different line in each cell

like

MR X
MR Y
MR Z

and in the other column with single line like

Success
Failed

Please see the below image for clear view.



In this case, I want to split the data in to each line in to each row.

Like MR X Failed
Mr Y Failed
Mr Z Failed and so on..

Can anybody has an Idea to solve my problem with a Macro?

Thank you in Advance.

Best Regards,

[patel]

Sub transpose10()
    LR = Cells(Rows.Count, "A").End(xlUp).Row
    outrow = 2
    outcol = 5
    For j = 2 To LR
        s = Cells(j, 1).Value
        suc = Cells(j, 2).Value
        ar = Split(s, Chr(10))
        For i = 0 To UBound(ar)
            Cells(i + outrow, outcol) = ar(i)
            Cells(i + outrow, outcol + 1) = suc
        Next
        outrow = i + outrow
    Next
End Sub

[snb]

Sub snb()
    sn = Cells(1).CurrentRegion
    For j = 2 To UBound(sn)
        c01 = c01 & Replace(sn(j, 1) & vbLf, vbLf, "_" & sn(j, 2) & vbLf)
    Next
    sn = Split(c01, vbLf)
    Cells(2, 5).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub

NB. Avoid merged cells in combination with VBA.

[Ctrl+s]

Sub transpose10()
    LR = Cells(Rows.Count, "A").End(xlUp).Row
    outrow = 2
    outcol = 5
    For j = 2 To LR
        s = Cells(j, 1).Value
        suc = Cells(j, 2).Value
        ar = Split(s, Chr(10))
        For i = 0 To UBound(ar)
            Cells(i + outrow, outcol) = ar(i)
            Cells(i + outrow, outcol + 1) = suc
        Next
        outrow = i + outrow
    Next
End Sub

Thank you very much for you help .

[Ctrl+s]

Sub snb()
    sn = Cells(1).CurrentRegion
    For j = 2 To UBound(sn)
        c01 = c01 & Replace(sn(j, 1) & vbLf, vbLf, "_" & sn(j, 2) & vbLf)
    Next
    sn = Split(c01, vbLf)
    Cells(2, 5).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub

NB. Avoid merged cells in combination with VBA.

Thank you very much for you help .