Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim olApp As Outlook.Application
Dim Cible As Outlook.ContactItem
Dim dossierContacts As Outlook.MAPIFolder
Dim Resultat As String
If Not Target.Address = "$A$1" Then Exit Sub
Set olApp = New Outlook.Application
Set dossierContacts = _
olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
For Each Cible In dossierContacts.Items
Resultat = Resultat & Cible.CompanyName & ","
Next
With Range("A1").Validation
.Delete
.Add xlValidateList, Formula1:=Left(Resultat, Len(Resultat) - 1)
End With
Set Cible = Nothing
Set dossierContacts = Nothing
'olApp.Quit
Set olApp = Nothing
End Sub