Liste déroulantes liées dans un autre fichier

Dim répertoire
Dim fichier
Private Sub UserForm_Initialize()
  'Microsoft ActiveX Data Object 2.8 doit être activé
  Dim rs As ADODB.Recordset
  Set cnn = New ADODB.Connection
  répertoire = ThisWorkbook.Path & "\"
  fichier = "BDD MP.xls"
  cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & répertoire & fichier
  Set rs = cnn.Execute("SELECT [Code Produit],[Désignation MP] FROM BD WHERE [Code Produit]<>'' group BY [Code Produit],[Désignation MP]")
  Me.ComboBox1.List = Application.Transpose(rs.GetRows)
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
  SendKeys "{F4}"
End Sub

Private Sub ComboBox1_Change()
  Dim rs As ADODB.Recordset
  Set cnn = New ADODB.Connection
  cnn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & répertoire & fichier
  Set rs = cnn.Execute("SELECT [Désignation fournisseur] FROM BD WHERE [Code Produit]='" & Me.ComboBox1 & "'")
  Me.ComboBox2.List = Application.Transpose(rs.GetRows)
  rs.Close
  cnn.Close
  Set rs = Nothing
  Set cnn = Nothing
  Me.ComboBox2.SetFocus
End Sub

Private Sub ComboBox2_Change()
  ActiveCell = Me.ComboBox1
  ActiveCell.Offset(1) = Me.ComboBox2
  ActiveCell.Offset(2) = Me.ComboBox1.Column(1)
  Unload Me
End Sub

=DECALER(BDD!$C$3;EQUIV('MP et Négoce'!$B$7;Liste1;0);;1+EQUIV('MP et Négoce'!$B$7;Liste1)-EQUIV('MP et Négoce'!$B$7;Liste1;0))

If Workbooks(fichier).Saved Then Workbooks(fichier).Sheets(F).[A:M].Copy .[A1]

[COLOR="Red"]Dim DateEnregistrement As Date 'mémorise la date et l'heure[/COLOR]

Sub MAJ()
Dim chemin$, fichier$, F$, o As Object, dat As Date, ouv As Boolean
chemin = ThisWorkbook.Path & "\"
fichier = "BDD MP.xls"
F = "Dossiers fournisseurs"
[COLOR="red"]Set o = CreateObject("Scripting.FileSystemObject")
dat = o.GetFile(chemin & fichier).DateLastModified 'date du dernier enregistrement[/COLOR]
If DateEnregistrement <> dat Then 'si la mise à jour est nécessaire
  On Error Resume Next
  If IsError(Workbooks(fichier).Name) Then 'si le fichier n'est pas ouvert
    Application.ScreenUpdating = False
    Workbooks.Open chemin & fichier
    ouv = True
  End If
  On Error GoTo 0
  With ThisWorkbook.Sheets("BDD")
    If Workbooks(fichier).Saved Then 'si le fichier n'est pas en cours de modification
      Workbooks(fichier).Sheets(F).Cells.Copy .[A1]
      [COLOR="red"]DateEnregistrement = dat[/COLOR]
    End If
    If ouv Then Workbooks(fichier).Close False
    .[A3:M65536].Sort Key1:=.[A3], Order1:=xlAscending, Key2:=.[C3], Order2:=xlAscending, Header:=xlYes 'tri de BDD par codes croissants
  End With
End If
Set o = Nothing
End Sub