VBA Split Cell Contents to New Rows & Copy Cells containing single values to the new rows

Please forgive me for any errors in improper posting. This is my first post.

I have a spreadsheet where some cells contain multiple lines of data separated by alt+enter. The data is contained in columns A:Q. The number of values in a cell varies, but for each line if any lines contain multiple values, the other lines will contain either nothing (blank), 1 value, or the same number of values as the other cells containing multiple values.
I want a macro to be able to split the cells that contain multiple lines of data into new rows and copy the remaining cells into the new rows.

Here is a sample of what I have although my data actually goes through column Q:

	A	B	C	D	E	F
1	abc	123 456 789 012	pqr stu vwx yza	A		C
2	def		123 456 789 012 345	abc def ghi jkl mno	ABC DEF GHI JKL MNO	F

I want the output to look like this:

	A	B	C	D	E	F
1	abc	123	pqr	A		C
2	abc	456	stu	A		C
3	abc	789	vwx	A		C
4	abc	012	yza	A		C
5	def		123	abc	ABC	F
6	def		456	def	DEF	F
7	def		789	ghi	GHI	F
8	def		012	jkl	JKL	F
9	def		345	mno	MNO	F

I am new to VBA, but copied this from another thread.

Sub SplitAltEnter()
Dim LR As Long, i As Long, r As Long
Dim MyArr, MyArr2, MyArr3, MyArr4
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row

    For i = LR To 1 Step -1
        If InStr(Cells(i, "C"), Chr(10)) > 0 Then
        'Fill the various arrays
            MyArr = Split(Cells(i, "B"), Chr(10))
            MyArr2 = Split(Cells(i, "C"), Chr(10))
            MyArr3 = Split(Cells(i, "D"), Chr(10))
            MyArr4 = Split(Cells(i, "E"), Chr(10))
         'Insert first row back into original cells
            Cells(i, "B") = MyArr(0)
            Cells(i, "C") = MyArr2(0)
            Cells(i, "D") = MyArr3(0)
            Cells(i, "E") = MyArr4(0)
         'Insert the remaining data into new rows
            For r = UBound(MyArr) To 1 Step -1
                Rows(i + 1).Insert xlShiftDown
                Cells(i + 1, "A") = Cells(i, "A")
                Cells(i + 1, "B") = MyArr(r)
                Cells(i + 1, "C") = MyArr2(r)
                Cells(i + 1, "D") = MyArr3(r)
                Cells(i + 1, "E") = MyArr4(r)
            Next r
        End If
    Next i


Columns("A:Q").EntireColumn.AutoFit


Application.ScreenUpdating = True
End Sub

It works fine for columns A:E, but when I try to add additional columns like below, I get a Run Time Error '9' Subscript out of Range with line "Cells(i + 1, "F") = MyArr5(r)" highlighted.

Sub SplitAltEnter()
Dim LR As Long, i As Long, r As Long
Dim MyArr, MyArr2, MyArr3, MyArr4, MyArr5
Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row

    For i = LR To 1 Step -1
        If InStr(Cells(i, "C"), Chr(10)) > 0 Then
        'Fill the various arrays
            MyArr = Split(Cells(i, "B"), Chr(10))
            MyArr2 = Split(Cells(i, "C"), Chr(10))
            MyArr3 = Split(Cells(i, "D"), Chr(10))
            MyArr4 = Split(Cells(i, "E"), Chr(10))
            MyArr5 = Split(Cells(i, "F"), Chr(10))
         'Insert first row back into original cells
            Cells(i, "B") = MyArr(0)
            Cells(i, "C") = MyArr2(0)
            Cells(i, "D") = MyArr3(0)
            Cells(i, "E") = MyArr4(0)
            Cells(i, "F") = MyArr5(0)
         'Insert the remaining data into new rows
            For r = UBound(MyArr) To 1 Step -1
                Rows(i + 1).Insert xlShiftDown
                Cells(i + 1, "A") = Cells(i, "A")
                Cells(i + 1, "B") = MyArr(r)
                Cells(i + 1, "C") = MyArr2(r)
                Cells(i + 1, "D") = MyArr3(r)
                Cells(i + 1, "E") = MyArr4(r)
                Cells(i + 1, "F") = MyArr5(r)
            Next r
        End If
    Next i


Columns("A:Q").EntireColumn.AutoFit


Application.ScreenUpdating = True
End Sub

I feel like I am missing something simple. Can anyone please help me out?

Thanks!