Split Data in one cell into below rows

[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 .