Liste déroulante EXCEL

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim l As Integer
Dim plage As Range

l = Range("A65536").End(xlUp).Row 'la macro détermine la longueur du tableau en fonction de la dernière ligne non vide de la colonne A (à mettre en jour si besoin)
Set plage = ActiveSheet.Range("A1:A" & l) 'remplace les "A" par l'adresse de la colonne où sont contenues les cellules où tu souhaites inscrire les initiales
'si ton tableau ne commence pas à la ligne 1 remplace le "1" par la première ligne de ton tableau

If Not Intersect(Target, plage) Is Nothing And Target.Cells.Count = 1 Then

Dim i As Integer, lg As Integer
Dim lib As String, initial As String
lib = ActiveCell.Value
lg = Len(ActiveCell.Value)

'1er lettre de la chaine si lettre
initial = Mid(lib, 1, 1)

'analyse du reste de l'intitulé et extrait les caractères situés après les espaces
For i = 2 To lg
If Mid(lib, i, 1) = " " And Mid(lib, i + 1, 1) <> " " Then
initial = initial & Mid(lib, i + 1, 1)
End If
Next i

'reporte les initiales dans la cellule
ActiveCell = UCase(initial)

End If
Application.EnableEvents = True

End Sub