Breaking down a list into more.

Since you have Office 365, use Power Query.

Assuming that you don't need to keep the hidden column ([UPC]).

Sample M code:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"STOCK VN CODE", type any}, {"Qty Avai", type any}, {"STOCK CN CODE1", type text}, {"Qty Avai2", Int64.Type}, {"SKU", type text}, {"FP FRAME SKKU", type text}, {"FP SKU", type text}, {"UPC", type text}, {"PRODUCT NAME", type text}, {"QTY Available", Int64.Type}}),
    #"Added Custom" = Table.AddColumn(#"Changed Type", "Custom", each Text.Split([FP SKU],"#(lf)")),
    #"Removed Columns" = Table.RemoveColumns(#"Added Custom",{"FP SKU", "UPC"}),
    #"Reordered Columns" = Table.ReorderColumns(#"Removed Columns",{"STOCK VN CODE", "Qty Avai", "STOCK CN CODE1", "Qty Avai2", "SKU", "FP FRAME SKKU", "Custom", "PRODUCT NAME", "QTY Available"}),
    #"Renamed Columns" = Table.RenameColumns(#"Reordered Columns",{{"Custom", "FP SKU"}}),
    #"Expanded FP SKU" = Table.ExpandListColumn(#"Renamed Columns", "FP SKU"),
    #"Changed Type1" = Table.TransformColumnTypes(#"Expanded FP SKU",{{"FP SKU", type text}})
in
    #"Changed Type1"

Sample file attached.

Try.

Sub test()
    Dim a(), af, v
    Dim i As Integer, ii As Integer, rw As Integer
    Dim d As Object
    Dim ms As String
    
    With Sheets("INDIVIDUAL INVENTORY")
        a = .[g1].CurrentRegion.Value
        ReDim af(1 To 5000, 1 To 8)
        For i = 2 To UBound(a)
            v = Split(a(i, 7), Chr(10))
            For ii = 0 To UBound(v)
                rw = rw + 1
                af(rw, 1) = a(i, 3): af(rw, 2) = a(i, 4): af(rw, 3) = a(i, 5)
                af(rw, 4) = a(i, 6): af(rw, 5) = v(ii): af(rw, 7) = a(i, 9): af(rw, 8) = a(i, 10)
            Next
        Next
        With .[a10].CurrentRegion.Offset(1)
            .ClearContents
            .Columns("c").Resize(rw, UBound(af, 2)).Value = af
        End With
    End With
End Sub

An, late to the party, another option to expand the data in-situ.

Option Explicit

Sub sSplitCells()

Dim lLR As Long, i As Long
Dim vArray
Dim rTemp As Range, cell As Range

Application.ScreenUpdating = False

' determine last row of data
lLR = Range("G" & Rows.Count).End(xlUp).Row

' expand rows
For i = lLR To 2 Step -1
    vArray = Split(Cells(i, "G"), Chr(10))
    If UBound(vArray) > 0 Then
        Cells(i, "G").Offset(1).Resize(UBound(vArray)).EntireRow.Insert
        Cells(i, "G").Offset(0).Resize(UBound(vArray) + 1) = Application.WorksheetFunction.Transpose(vArray)
    End If
Next 'i

' recalculate last row of data
lLR = Range("G" & Rows.Count).End(xlUp).Row

' fill blank cells
Set rTemp = Range("A3:J" & lLR).SpecialCells(xlCellTypeBlanks)
Range("A3:J" & lLR).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = _
        "=IF(R[-1]C="""","""",R[-1]C)"

' convert previously blank cell formulae to values
For Each cell In rTemp
    With cell
        .Value = .Value
    End With
Next 'cell

Application.ScreenUpdating = True

End Sub

Power Query with UPC

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    AddT = Table.AddColumn(Source, "T", each Table.FromColumns({Text.Split([FP SKU],"#(lf)"),Text.Split([UPC],"#(lf)")},{"FP SKU","UPC"})),
    Removed = Table.RemoveColumns(AddT,{"FP SKU", "UPC"}),
    ExpandedT = Table.ExpandTableColumn(Removed, "T", {"FP SKU", "UPC"}, {"FP SKU", "UPC"}),
    ReorderedColumns = Table.ReorderColumns(ExpandedT,List.InsertRange(List.Difference(Table.ColumnNames(Source),{"FP SKU", "UPC"}),6,{"FP SKU", "UPC"}))
in
    ReorderedColumns

You're welcome.

Range("D2").AutoFill Destination:=Range("D2:D" & lLR), Type:=xlFillDefault

If you are satisfied with the solution(s) provided, please mark your thread as Solved.


New quick method:
Select Thread Tools-> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

Or you can use this way:

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save


You may also want to consider thanking those people who helped you by clicking on the little star at the bottom left of their reply to your question.

This should do it:

Option Explicit

Sub sSplitCells_V2()

Dim wsf As WorksheetFunction: Set wsf = WorksheetFunction
Dim lLR As Long, i As Long
Dim vArray, vArrayH
Dim rTemp As Range, cell As Range

Application.ScreenUpdating = False

' determine last row of data
lLR = Range("G" & Rows.Count).End(xlUp).Row

' expand rows
For i = lLR To 2 Step -1
    vArray = Split(Cells(i, "G"), Chr(10))
    vArrayH = Split(Cells(i, "H"), Chr(10))
    If UBound(vArray) > 0 Then
        Cells(i, "G").Offset(1).Resize(UBound(vArray)).EntireRow.Insert
        Cells(i, "G").Offset(0).Resize(UBound(vArray) + 1) = wsf.Transpose(vArray)
        Cells(i, "H").Offset(0).Resize(UBound(vArrayH) + 1).NumberFormat = "@"
        Cells(i, "H").Offset(0).Resize(UBound(vArrayH) + 1) = wsf.Transpose(vArrayH)
    End If
Next 'i

' recalculate last row of data
lLR = Range("G" & Rows.Count).End(xlUp).Row

' fill blank cells
Set rTemp = Range("A3:J" & lLR).SpecialCells(xlCellTypeBlanks)
Range("A3:J" & lLR).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = _
        "=IF(R[-1]C="""","""",R[-1]C)"

' convert previously blank cell formulae to values
For Each cell In rTemp
    With cell
        .Value = .Value
    End With
Next 'cell

Application.ScreenUpdating = True

End Sub

You're welcome. Thanks for the rep.