How about this?
Option Explicit

Sub test()
    Dim myAreas As Areas, i As Long
    If Application.CountIf(Columns(1), "Yes") = 0 Then Exit Sub
    Application.ScreenUpdating = False
    Columns(1).Insert
    With Range("b2", Range("b" & Rows.Count).End(xlUp)).Offset(, -1)
        .Formula = "=if(and(b1=""Yes"",b2=""No""),if(a1=1,""a"",1),"""")"
        .Value = .Value
        On Error Resume Next
        .SpecialCells(2, 1).EntireRow.Insert
        .SpecialCells(2, 2).EntireRow.Insert
        On Error GoTo 0
    End With
    Columns(1).Delete
    Set myAreas = Columns(1).SpecialCells(2).Areas
    For i = myAreas.Count To 1 Step -1
        With myAreas(i).CurrentRegion
            If (.Rows.Count > 1) * (.Cells(.Rows.Count, 1).Value = "Yes") Then
                .Cells(.Rows.Count - 1, 2).Value = .Cells(.Rows.Count, 2).Value
                .Rows(.Rows.Count).EntireRow.Delete
            End If
        End With
    Next
    Range("a2", Range("a" & Rows.Count).End(xlUp)) _
    .SpecialCells(4).EntireRow.Delete
    Set myAreas = Nothing
    test
    Application.ScreenUpdating = True
End Sub