HELP splitting out text in one cell into many rows quickly

[vba1234]

Hi

I have attached an example of an excel spreadsheet and i need help splitting it out column O into different rows ie 1), 2), 3) on different rows but the rest columns need to be the same.

Let me know if you have any questions

Please can someone help ASAP

[JohnTopley]

first, are you still using Excel 2010? if not, please update your profile with your current Excel version (oldest if there are multiple Excel versions being used)..

And please add expected results to your file.

[vba1234]

Hi I am using excel 365 and i have updated this.

Please see attached answer

You can see column O only gets split and rest remains the same due to control activites per risk activity.

[JohnTopley]

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