Option Explicit
Sub Importation_Donnees_Word()
Dim rep$, i&, Temp$, fs
Dim Wapp As Object, Wdoc As Object, WSel As Object
Application.ScreenUpdating = False
rep = "D:\Downloads\projet\word\"
Temp = Dir(rep & "*.docx")
i = [A65536].End(3)(2).Row
Set Wapp = CreateObject("Word.Application")
Wapp.Visible = -1
Do While Temp <> ""
Set Wdoc = Wapp.Documents.Open(rep & Temp)
Wapp.Selection.HomeKey unit:=6
Wapp.Selection.Find.ClearFormatting
Wapp.Selection.Find.Execute "@"
Wapp.Selection.Moveleft unit:=3, Count:=1, Extend:=0
Wapp.Selection.MoveRight unit:=3, Count:=1, Extend:=1
Set WSel = Wapp.Selection
Cells(i, 1) = WSel
Wdoc.Close
i = i + 1
Temp = Dir
Loop
End Sub