macro pour sélection et recopie

Sub TransfertSurWord()
[COLOR="Red"]'cocher la référence => Microsoft Forms x.x ObjectLibrary
'cocher la référence => Microsoft Word xx.x ObjectLibrary[/COLOR]
Dim MyData As DataObject, WordApp As Word.Application
Set MyData = New DataObject
MyData.SetText [C1] & Chr(10) & [C3] & Chr(10) & [C4] & Chr(10) & [C8]
MyData.PutInClipboard [COLOR="red"]'alimente le presse-papier[/COLOR]
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
AppActivate "TOTO - Microsoft Word" [COLOR="red"]'facultatif, si le fichier Word s'appelle TOTO[/COLOR]
WordApp.Selection.Paste [COLOR="red"]'transfère le contenu du presse-papier sur la sélection[/COLOR]
If Err Then MsgBox "Ouvrez le fichier Word concerné !"
End Sub

Sub TransfertSurWord()
'cocher la référence => Microsoft Word xx.x ObjectLibrary
Dim txt$, WordApp As Word.Application
[COLOR="Red"]txt[/COLOR] = [C1] & Chr(10) & [C3] & Chr(10) & [C4] & Chr(10) & [C8]
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
AppActivate "TOTO - Microsoft Word" 'facultatif, si le fichier Word s'appelle TOTO
WordApp.Selection = txt 'transfère le texte
If Err Then MsgBox "Ouvrez le fichier Word concerné !"
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = "$C$1" Then
Cancel = True
[COLOR="Red"]TransfertSurWord[/COLOR]
End If
End Sub

Sub TransfertSurWord()
'cocher la référence => Microsoft Word xx.x ObjectLibrary
Dim WordApp As Word.Application
Columns("C").Insert 'crée une colonne auxiliaire
Range("D1,D3:D4,D8").Copy Range("C1")
Range("C1:C4").Copy
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
AppActivate "TOTO - Microsoft Word" 'facultatif, si le fichier Word s'appelle TOTO
WordApp.Selection.Paste 'transfère les cellules
Columns("C").Delete 'supprime la colonne auxiliaire
If Err Then MsgBox "Ouvrez le fichier Word concerné !"
End Sub