Sub Copier(Chemin, Nom_New)
Dim Chemin11 As String
Dim Nom_New1 As String
Dim Chemin_complet As String
Dim Der_Lig2 As Long
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Chemin11 = Chemin & "\"
Nom_New1 = Nom_New & ".doc"
Chemin_complet = Chemin11 & Nom_New1
'ouvre une session Word
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
'crée un nouveau document
Set WordDoc = WordApp.Documents.Add
'enregistre le nouveau doc
WordDoc.SaveAs Chemin_complet
NomFeuille1 = ActiveSheet.Name
Der_Lig2 = Worksheets(NomFeuille1).Range("A" & Rows.Count).End(xlUp).Row
'boucle sur toutes les lignes renseignées
For j = 1 To Der_Lig2
'copier les les lignes d'Excel dans le document Word
Cells(j, 1).Copy
WordApp.Selection.Paste
WordDoc.Tables(1).AutoFitBehavior wdAutoFitWindow
Next j
Application.CutCopyMode = False
End Sub