J'ai essayé cela, mais le nombre reste à 1
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("BA2:BA70 ")) Is Nothing Then
With Target
With .Font
.Name = "Wingdings"
.Size = 10
.Bold = True
End With
.Value = IIf(.Value = "", "ü", "")
End With
Dim DerL As Integer
Dim shA As Worksheet
Set shA = Sheets("Archives")
DerL = shA.Range("BA" & Rows.Count).End(xlUp).Row + 1
With Worksheets("Effectif")
.Range(.Cells(Target.Row, "A"), .Cells(Target.Row, "BA")).Copy shA.Range("A" & DerL)
shA.Range("BB" & DerL) = InputBox("A quelle date est parti le jeune ?" & Chr(10) & "Veuillez saisir la date au format JJ/MM/AAAA", "Date de départ")
shA.Range("BC" & DerL) = InputBox("Dans quelle ville est parti le jeune ?" & Chr(10) & "Veuillez saisir le lieu", "Ville")
shA.Range("BD" & DerL) = InputBox("Avec quel partenaire est parti le jeune ?" & Chr(10) & "Veuillez saisir le partenaire", "ADMA, CAPS, CHRS, FJT, SAS, SHAMNA, autre ?")
shA.Range("BE" & DerL) = Application.Max(Columns("BE")) + 1
.Rows(Target.Row).Delete
End With
Cancel = True
End If
End Sub