Sub test()
Dim Rg As Range
Dim Wd As Word.Application
Dim Dc As Document, C As Column
Dim T As Table, P As Row
Dim A As Integer, B As Integer
Dim Bb As Border
'Defined range to copy
With Worksheets("Sheets1")
Set Rg = .Range("A1:D5")
End With
Set Wd = CreateObject("Word.Application")
Wd.Visible = True
Set Dc = Wd.Documents.Open(Chemin & "\" & NomFichier.docx")
Dc.Selection.GoTo What:=wdGoToBookmark, Name:="TableauExcel"
Set T = Dc.Tables.Add(Range:=Dc.Range, _
NumRows:=Rg.Rows.Count, _
NumColumns:=Rg.Columns.Count)
For A = 1 To Rg.Rows.Count
For B = 1 To Rg.Columns.Count
T.Cell(A, B).Range = Rg(A, B)
Next
Next
'To apply borders if necessary
With T
For Each C In .Range.Columns
C.Borders(wdBorderHorizontal).Visible = True
Next
For Each P In .Range.Rows
P.Borders(wdBorderVertical).Visible = True
Next
For A = -4 To -1
.Range.Borders(A) = True
Next
End With
End Sub