Bonjour,
Private Sub Worksheet_Change(ByVal Target As Range)
Set f = Sheets("listes")
If Target.Address = "$B$2" And Target.Count = 1 Then
If Target <> "" Then
If IsError(Application.Match(Target.Value, [choix1], 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
[choix1].End(xlToRight).Offset(0, 1) = Target.Value
c = f.Range("choix2").Column
n = Application.CountA([choix1])
f.Range(f.Cells(1, c), f.Cells(10, c + n)).Sort _
Key1:=f.Cells(1, c), Order1:=xlAscending, Header:=xlNo, _
Orientation:=xlLeftToRight
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
Else
Target.Offset(0, 1) = f.Range("choix2")(1).Offset(1, Application.Match(Target, [choix1], 0) - 1)
End If
End If
End If
If Target.Address = "$C$2" And Target.Count = 1 Then
If Target <> "" Then
d = Application.Match(Target.Offset(0, -1), [choix1], 0) - 1
If IsError(Application.Match(Target.Value, [choix2].Offset(0, d), 0)) Then
If MsgBox("On ajoute?", vbYesNo) = vbYes Then
n = Application.CountA([choix2].Offset(0, d))
c = f.Range("choix2").Column
f.Cells(n + 1, c + d) = Target.Value
If n > 1 Then
f.Range(f.Cells(2, c + d), f.Cells(n + 1, c + d)).Sort _
Key1:=f.Cells(2, c + d), Order1:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlNo
End If
Else
On Error Resume Next
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End If
End If
End If
End Sub
Boisgontier