Sub ListesWord()
Dim P As Range, n As Byte, o As Object, i&
With Feuil1 'CodeName
Set P = Union(.Range("A2", .Range("A" & .Rows.Count).End(xlUp)), _
.Range("C2", .Range("C" & .Rows.Count).End(xlUp)), _
.Range("E2", .Range("E" & .Rows.Count).End(xlUp)))
End With
Set o = CreateObject(ThisWorkbook.Path & "\charlie liste deroulante.docx") 'à adapter
o.Parent.Visible = True
For n = 1 To P.Areas.Count
With o.ContentControls(n) 'autant de contrôles que de zones
.DropdownListEntries.Clear 'RAZ
For i = 1 To P.Areas(n).Count
.DropdownListEntries.Add P.Areas(n)(i).Text
Next
End With
Next
AppActivate o.Parent.Caption
End Sub