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]

[VBA]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[/VBA]

[snb]

[vba]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[/vba]

NB. Avoid merged cells in combination with VBA.

[Ctrl+s]

[vba]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[/vba]

Thank you very much for you help .

[Ctrl+s]

[vba]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[/vba]
NB. Avoid merged cells in combination with VBA.

Thank you very much for you help .