Sub SignetsWord()
On Error Resume Next
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim Fich As Worksheet
Chemin2 = ThisWorkbook.Path & "\" & "Devis\"
Dim AnyString, MyStr
Set wordApp = CreateObject("Word.Application")
For n = 8 To Range("A500").End(xlUp).Row
'AnyString = n
'If MyStr = Left(AnyString, 5) = "Devis" Then
[COLOR="Red"] If Range("A" & n) <> "" Then[/COLOR]
monDocument = Chemin2 & Range("A" & n)
Set wordDoc = Documents.Open(Chemin2 & Range("A" & n))
DoEvents
Range("D" & n) = wordDoc.Bookmarks("Montant_ht").Range
Range("E" & n) = wordDoc.Bookmarks("TVA").Range
End If
Next n
wordApp.Quit
End Sub