HELP splitting out text in one cell into many rows quickly

Option Explicit

Sub demo()
Dim a, b
Dim i As Long, j As Long, k As Long, n As Long, lr As Long
Dim t() As String
With Sheets("Sheet1")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    a = .Range("A13:O" & lr)
    ReDim b(1 To 15, 1 To 10000)
    n = 0
    For i = 1 To UBound(a, 1)
        t = Split(a(i, 15), Chr(10) & Chr(10))
        For j = 0 To UBound(t, 1)
            n = n + 1
            b(15, n) = t(j)
            For k = 1 To 14
                b(k, n) = a(i, k)
            Next k
        Next j
    Next i
End With

With Sheets("Sheet2")
    .[A8].Resize(n, 15) = Application.Transpose(b)
    .[A8].Resize(n, 15).HorizontalAlignment = xlCenter
    .[A8].Resize(n, 15).VerticalAlignment = xlCenter
End With
End Sub