Sub ToWords()
Dim appWord As Word.Application
Dim docWord As Word.Document
tablo = Range("A1:C76").Value
Set appWord = CreateObject("Word.Application")
appWord.Visible = False
Set docWord = appWord.Documents.Open(ActiveWorkbook.Path & "\Modele.doc")
With docWord
.Tables.Add .Bookmarks("Tableau").Range, UBound(tablo, 1), UBound(tablo, 2)
For i = 1 To UBound(tablo, 1)
For j = 1 To UBound(tablo, 2)
.Tables(1).Cell(i, j).Range.Text = tablo(i, j)
Next
Next
.Tables(1).AutoFitBehavior 2
.SaveAs ActiveWorkbook.Path & "\Essai2.doc"
.Close
End With
appWord.Quit
End Sub