Const sSh = "TST1", sSource = "A:B", sCellMatricule = "E3", sCellNom = "F3"
Dim Matricules As New Scripting.Dictionary, Plage As Range
Dim Sh As Worksheet, CellNom As Range
Public Source As Range, CellMatricule As Range
Sub InitVar()
  Set Sh = ThisWorkbook.Sheets(sSh)
  With Sh
    Set Source = Sh.Range(sSource)
    Set CellMatricule = Sh.Range(sCellMatricule)
    Set CellNom = Sh.Range(sCellNom)
    Set Plage = .Cells(.Rows.Count, Source.Column).End(xlUp)
    Set Plage = .Range(Source(2, 1), Plage.Offset(, 1))
  End With
End Sub
Sub CreerDico()
Dim xcell As Range
  
  If (Source Is Nothing) Or (CellNom Is Nothing) Then InitVar
  Matricules.RemoveAll
  For Each xcell In Plage.Resize(, 1)
    If Matricules.Exists(xcell.Value) Then
      Matricules(xcell.Value) = Matricules(xcell.Value) & "," & xcell.Offset(, 1).Value
    Else
      Matricules(xcell.Value) = xcell.Offset(, 1).Value
    End If
  Next xcell
End Sub
Sub ValidationMatricule()
Dim Aux, i&
  Aux = Matricules.Keys
  Qsort Aux, LBound(Aux), UBound(Aux)
  'Verif si actuel matricule existe
  If Not Matricules.Exists(CellMatricule.Value) Then CellMatricule = ""
  With CellMatricule.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=Join(Aux, ",")
  End With
End Sub
Sub ValidationNom()
Dim auxMatr, auxNoms, i&, S, Z
  
  auxMatr = Plage.Resize(, 1).Value
  auxNoms = Plage.Offset(, 1).Resize(, 1).Value
  For i = 1 To UBound(auxMatr)
    If auxMatr(i, 1) = CellMatricule Then
      S = S & "," & auxNoms(i, 1)
    End If
  Next i
  S = S & "," & "------------"
  For i = 1 To UBound(auxMatr)
    If auxMatr(i, 1) <> CellMatricule Then
      S = S & "," & auxNoms(i, 1)
    End If
  Next i
  If Left(S, 1) = "," Then S = Mid(S, 2)
  With CellNom.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=S
  End With
  'Vérif valeur de Nom par rapport au matricule
  If CellMatricule = "" Or Left(CellMatricule, 2) = "--" Then
    CellNom = ""
    CellMatricule.Activate
  Else
    Z = "," & CellNom & ","
    If InStr("," & Matricules.Item(CellMatricule.Value) & ",", Z) = 0 Then
      CellNom = Split(Matricules.Item(CellMatricule.Value), ",")(0)
      CellNom.Activate
    End If
  End If
End Sub