Split Multi line Cell text Into Multiple Rows in range

Sub splitCells()
    Application.ScreenUpdating = False
    Dim LastRow As Long, x As Long, splitPN As Variant, i As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For x = LastRow To 2 Step -1
        splitPN = Split(Cells(x, 2), Chr(10))
        If UBound(splitPN) > 0 Then
            For i = UBound(splitPN) To 1 Step -1
                Rows(x + 1).Insert
                Cells(x + 1, 1) = Cells(x, 1)
                Cells(x + 1, 2) = splitPN(i)
            Next i
        End If
        Cells(x, 2) = splitPN(0)
    Next x
    Application.ScreenUpdating = True
End Sub