Auto insert cells row beneath based on cell value

See if this give the desired result

Sub test()
Dim ws As Worksheet, lastrow As Long, x As Long, qtyes As Byte
Set ws = Sheets("Before")
Application.ScreenUpdating = False
With ws
    lastrow = .Range("A" & Rows.Count).End(xlUp).Row
    For x = lastrow To 2 Step -1
        qtyes = Application.CountIf(.Range("J" & x, "K" & x), "Yes")
        If qtyes = 2 Then
            .Range("A" & x + 1, "A" & x + 2).EntireRow.Insert
            .Range("F" & x + 1).Resize(1, 6) = .Range("L" & x, "Q" & x).Value
            .Range("F" & x + 2).Resize(1, 6) = .Range("R" & x, "W" & x).Value
        End If
        If qtyes = 1 Then
            .Range("A" & x + 1).EntireRow.Insert
            .Range("F" & x + 1).Resize(1, 6) = .Range("L" & x, "Q" & x).Value
        End If
    Next
    lastrow = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("L2", "W" & lastrow).ClearContents
End With
Application.ScreenUpdating = True
End Sub

Kind regards
Leo