Sub Insereligne()
Dim code, c, cel As Range
code = Array("D712", "D727") 'les codes à traiter
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'à cause des formules de liaison tordues...
For Each c In code
Set cel = [B:B].Find(c, , xlValues, xlWhole, , xlPrevious)
If Not cel Is Nothing Then
cel(2).Resize(, 12).Insert xlDown
cel.Resize(, 12).Copy cel(2)
cel.Resize(, 12) = cel.Resize(, 12).Value 'supprime les formules
cel(2, 4) = DateAdd("yyyy", 1, cel(2, 4))
cel(2, 5) = DateAdd("yyyy", 1, cel(2, 5))
End If
Next
Cells(4, 2) = Cells(4, 2) + 1
Sheets("Calendrier").Select Range("D3:D33,G3:G33,J3:J33,M3:M33,P3:P33,S3:S33,V3:V33,Y3:Y33,AB3:AB33,AE3:AE33,AH3:AH33,AK3:AK33").Select
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
End Sub