Bonjour,
Je ne suis pas sûr que tu aies suffisament regardé ma solution
Ton code est devenu :
Sub Origine_MP()
Dim Réf As String, formule As String
Dim x As Long
Cells(15, 2).ClearContents
Sheets("TRAME").Cells(15, 2).Validation.Delete
If Sheets("TRAME").Range("b14") = "" Or Sheets("TRAME").Range("b13") = "" Then Exit Sub
With Sheets("Base Qualité")
Réf = Sheets("TRAME").Cells(14, 2) & Sheets("TRAME").Cells(13, 2)
For x = 5 To .Range("A" & Rows.Count).End(xlUp).Row
If .Cells(x, 4) & .Cells(x, 6) = Réf Then
If .Cells(x, 7).Value <> "" Then
formule = formule & IIf(formule = "", "", ",") & .Cells(x, 7)
End If
End If
Next x
End With
If formule <> "" Then
With Sheets("TRAME").Cells(15, 2).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=formule
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
With Sheets("TRAME").Cells(15, 2)
If InStr(1, formule, ",") = 0 Then
.Value = formule
Else
.Value = ""
End If
End With
End If
End Sub
Cette partie
If .Cells(x, 4) & .Cells(x, 6) = Réf Then
If .Cells(x, 7).Value <> "" Then
formule = formule & IIf(formule = "", "", ",") & .Cells(x, 7)
End If
End If
Vérifie toujours que les valeurs des colonnes 4 et 6 matchent toujours ta référence, sans quoi, la variable formule ne change pas de valeur.
C'est cette variable qui alimente ensuite ta liste, ce n'est donc pas une simple liste, c'est une liste générée par VBA à partir des lignes qui remplissent ton critère, si tu prends le temps de tester en ajoutant des valeurs qui ne devront pas être dans la liste, tu devrais voir qu'elles n'apparaissent pas...
Tu voulais pouvoir choisir parmis les origines qui correspondent à tes critères, j'appelle ça une liste, je t'ai donc fait une liste