Inserer ligne automatiquement avec condition

Sub Insereligne()
Dim plage As Range, ncol%, code, c, cel As Range
Set plage = Range("B3:G" & [B3].End(xlDown).Row) 'à adapter
ncol = plage.Columns.Count
code = Array("D712", "D727") 'les codes à traiter
Application.ScreenUpdating = False
For Each c In code
  For Each cel In plage.Columns(1).Cells
    If cel = c Then
      cel(2).Resize(, ncol).Insert xlDown
      cel.Resize(, ncol).Copy cel(2)
      cel(2) = "µµµ" 'caractères provisoires
      cel(2, 5) = DateAdd("m", 6, cel(1, 5))
    End If
  Next
  plage.Columns(1).Replace "µµµ", c
Next
End Sub

Set plage = Range("B3:G" & [B3].End(xlDown).Row + 1) 'à adapter

Sub Insereligne()
Dim P As Range, ncol%, code, c, i&
Set P = Range("B3:G" & [B3].End(xlDown).Row) 'à adapter
ncol = P.Columns.Count
code = Array("D712", "D727") 'les codes à traiter
Application.ScreenUpdating = False
For Each c In code
  For i = P.Rows.Count To 1 Step -1
    If P(i, 1) = c Then
      P(i + 1, 1).Resize(, ncol).Insert xlDown
      P(i, 1).Resize(, ncol).Copy P(i + 1, 1)
      P(i + 1, 5) = DateAdd("m", 6, P(i, 5))
    End If
  Next
Next
End Sub

Sub Insere2lignes()
Dim P As Range, ncol%, code, c, i&
Set P = Range("B3:G" & [B3].End(xlDown).Row) 'à adapter
ncol = P.Columns.Count
code = Array("D712") 'les codes à traiter
Application.ScreenUpdating = False
For Each c In code
  For i = P.Rows.Count To 1 Step -1
    If P(i, 1) = c Then
      P(i + 1, 1).Resize(2, ncol).Insert xlDown
      P(i, 1).Resize(, ncol).Copy P(i + 1, 1).Resize(2)
      P(i + 1, 5) = DateAdd("m", 4, P(i, 5))
      P(i + 2, 5) = DateAdd("m", 4, P(i + 1, 5))
    End If
  Next
Next
End Sub

Sub Insere2lignes()
Dim P As Range, ncol%, nlig&, code, c, t, i&, n&, j%
Set P = Range("B3:G" & Range("B" & Rows.Count).End(xlUp).Row) 'à adapter
ncol = P.Columns.Count
nlig = P.Rows.Count
code = Array("D712") 'les codes à traiter
'---dimensions du tableau final---
For Each c In code
  nlig = nlig + 2 * Application.CountIf(P.Columns(1), c)
Next
If nlig + 2 > Rows.Count Then MsgBox "Le nouveau tableau sort de la feuille !": Exit Sub
ReDim t(1 To nlig, 1 To ncol) 'tableau VBA, base 1
'---remplissage du tableau VBA---
For i = 1 To P.Rows.Count
  n = n + 1
  For j = 1 To ncol
    t(n, j) = P(i, j)
  Next
  For Each c In code
    If P(i, 1) = c Then
      For j = 1 To ncol
        t(n + 1, j) = t(n, j)
        t(n + 2, j) = t(n, j)
      Next
      t(n + 1, 5) = DateAdd("m", 4, t(n, 5))
      t(n + 2, 5) = DateAdd("m", 4, t(n + 1, 5))
      n = n + 2
    End If
  Next
Next
'---formatage et restitution---
Application.ScreenUpdating = False
If nlig > 1 Then P.Rows(2).Copy P.Rows(2).Resize(nlig - 1)
P.Rows(1).Resize(nlig) = t
End Sub