Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'---cocher la référence Microsoft Word xx.x Object Library---
If Target.Address <> "$A$1" Then Exit Sub
Cancel = True
Dim App As Word.Application, s As Object
On Error Resume Next
Set App = GetObject(, "Word.Application")
Set s = App.ActiveDocument.Bookmarks("TM")
If s Is Nothing Then MsgBox "Signet TM introuvable !": Exit Sub
On Error GoTo 0
s.Range.Copy
Me.PasteSpecial "Texte" '"Texte Unicode"
Target.Select
End Sub