Sub Word()
Dim chemin$, nom$, c As Range, tablo, ub%, i&, x$, j%, txt$, WApp As Object
chemin = ThisWorkbook.Path & "\"
nom = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
tablo = [A1].CurrentRegion 'matrice, plus rapide
ub = UBound(tablo, 2)
For i = 1 To UBound(tablo)
x = ""
For j = 1 To ub
x = x & ", " & tablo(i, j)
Next j
txt = txt & vbLf & Mid(x, 3)
Next i
On Error Resume Next
Set WApp = GetObject(, "Word.Application")
If WApp Is Nothing Then Set WApp = CreateObject("Word.Application")
WApp.documents(nom).Close False 'si le document est ouvert on le ferme
On Error GoTo 0
With WApp.documents.Add
.Range.Text = Mid(txt, 2)
.SaveAs chemin & nom
If WApp.documents.Count = 1 Then .Application.Quit Else .Close
End With
End Sub