Program modified:

Sub amartinPQ(): Dim B As Date, E As Date, r As Long, s As Long, c As Long
Dim ws As Worksheet, P, Q, N As Long: Set ws = ActiveSheet
P = ws.UsedRange: Q = ws.Cells(1, 1).Resize(2 * UBound(P, 1), UBound(P, 2)):
N = P(2, 3): s = 2
For r = 2 To UBound(P) - 1
For c = 1 To UBound(P, 2): Q(s, c) = P(r, c): Next c
If P(r + 1, 3) = N Then
B = P(r + 1, 9): E = B - 1: B = P(r, 9)
        If Q(s, 10) <> E Then _
s = s + 1: For c = 1 To UBound(P, 2): Q(s, c) = P(r, c): Next c: _
Q(s, 9) = B + 1: Q(s, 10) = E: Q(s, 14) = 0
Else
N = P(r + 1, 3): End If
s = s + 1: Next r
ws.Cells(1, 1).Resize(2 * UBound(P, 1), UBound(P, 2)) = Q
End Sub