Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim I As Integer, Ligne As Long
If Target.Column <> 6 Then Exit Sub
I = MsgBox("Voulez-vous insérer une ligne ?", vbOKCancel, "Insertion")
If I = vbCancel Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Ligne = Target.Row + 1
With Sh
.Rows(Ligne).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows(Ligne - 1).Copy .Cells(Ligne, 1)
.Cells(Ligne, 9) = 0
.Cells(Ligne, 10) = 0
.Cells(Ligne, 11) = 0
.Cells(Ligne, 12) = 0
.Cells(Ligne, 13) = 0
.Cells(Ligne, 14) = 0
.Cells(Ligne, 15) = 0
Union(.Cells(Ligne, 4), .Cells(Ligne, 6), .Cells(Ligne, 7)).ClearContents
Cancel = True
Target.Offset(1, 0).Select
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub