Private Sub Worksheet_Change(ByVal Target As Range)
Dim Wapp As Object
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
On Error GoTo 0
Wapp.Visible = True
With Wapp.Documents.Open(ThisWorkbook.Path & "\Document Word.docx")
.Tables(1).Cell(1, 2).Range.Text = Cells(3, 1)
.Tables(1).Cell(2, 2).Range.Text = Cells(5, 1)
.Tables(1).Cell(3, 2).Range.Text = Cells(6, 1)
End With
End Sub