Sub ListeEttiquete()
Dim WordObj As Object, Doc As Object
Dim i&, j&
Set WordObj = CreateObject("Word.Application")
Const wdGoToBookmark = -1
WordObj.Visible = True
'Ouvre le document modèle existant dans le répertoire spécifique
Set Doc = WordObj.Documents.Open("C:\Users\martin\Desktop\etiquettes.doc")
For i = 20 To 61
For j = 1 To 41
With WordObj.Selection ' assignation des signets
.GoTo What:=wdGoToBookmark, Name:="tube&j" ' recherche du signet - ' remplissage 1ere en tête
.TypeText Text:=Cells(3, i).Text ' remplacer le signet par le texte de la cellule B3
' Signet dimensions
.GoTo What:=wdGoToBookmark, Name:="dim&j"
.TypeText Text:=[D11].Text
'Signets coulée
.GoTo What:=wdGoToBookmark, Name:="coulee&j"
.TypeText Text:=[D9].Text
'Signets lots
.GoTo What:=wdGoToBookmark, Name:="lot&j"
.TypeText Text:=[D8].Text
End With
Next
Next
Set Doc = Nothing
Set WordObj = Nothing
End Sub