Choix dans une liste déroulante

Bonjour

bien qu'ayant parcouru les billets sur ce sujet, je ne trouve pas la solution à mon problème.

Je souhaite, à partir d'une listé déroulante proposant plusieurs choix, pouvoir saisir dans une seule cellule plusieurs des propositions de la liste déroulante. Est ce possible?

Ex je souhaite qu'à ,partir des propositions dans la colonne C, je puisse rentrer en A2 et A3 plusieurs choix dans une même cellule

Merci de votre concours

Cordialement

Bonsoir,

Cette question a déjà été traitée à diverses reprises. Je me souviens avoir fait au moins deux réponses sur ce type de question...

Ces réponses faisant partie de mes fichiers non classés, il est très aléatoire que je remette la main dessus mais j'ai pu tout de même en détecter un. Il s'agit d'une procédure évènementielle de type Change à placer dans le module de la feuille concernée.

La procédure permet d'insérer successivement les choix de l'utilisateur, ainsi que modifier en sélectionnant un choix déjà inscrit, qui alors sera supprimé. Le séparateur des différents choix est constitué par un slash entouré d'espaces (" / ").

A toi de l'adapter à ta configuration...

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tx, i%, ntx$
    If Target.Row < 2 Or Target.Count > 1 Then Exit Sub
    If Intersect(Target, Me.Columns("V:W")) Is Nothing Then Exit Sub
    On Error Resume Next
    If Target.SpecialCells(xlCellTypeAllValidation).Cells.Count > 0 Then
        If Err.Number <> 0 Then Exit Sub
        If Target.Validation.Type = xlValidateList Then
            If Err.Number <> 0 Then Exit Sub
        End If
    End If
    On Error GoTo 0
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    ntx = Target.Value
    Application.Undo
    tx = Target.Value
    If tx = "" Then
        tx = ntx
    ElseIf Not tx Like "* / *" Then
        If tx = ntx Then
            tx = ""
        Else
            tx = tx & " / " & ntx
        End If
    Else
        tx = Split(tx, " / ")
        For i = 0 To UBound(tx)
            If tx(i) = ntx Then
                ntx = "": tx(i) = "@"
                Exit For
            End If
        Next i
        If ntx <> "" Then
            tx = Join(tx, " / ") & " / " & ntx
        Else
            tx = Replace(Join(tx, " / "), " / @", "")
            If tx Like "@*" Then tx = Replace(tx, "@ / ", "")
        End If
    End If
    Target.Value = tx
    Application.EnableEvents = True
End Sub

Cordialement.