Recopier dans un tableau word des données Excel

Bonjour à tous,

En naviguant à la recherche d'informations sur l'utilisation de VBA sur Excel, je suis tombé sur ce forum, où j'y ai trouvé des réponses très pertinentes pour diverses sujets.

Mon problème: Je souhaite recopier une colonne de données Excel dans un tableau Word existant.

L'idée serait de positionner le curseur word sur la première cellule excel à copier et coller l'ensemble dans le tableau word. Faire la même manip pour les colonnes suivantes. Attention mon tableau Excel est équipé d'un filtre et donc les colonnes n'ont pas systématiquement la même taille.

J'avais "bidouillé" le code ci-dessous, mais il ne copie que cellule par cellule. Tandis que je souhaite copier et coller une colonne entière:

Sub Coller_Cellule_Avec_Un_Lien_Dans_Document_Word_Ouvert()

Dim Wd As Object, Dc As Object

Dim Plg As Object, Rg As Range

Dim Nb As Long

'Empêche le rafraîchissement de l'écran du moniteur

Application.ScreenUpdating = False

'Capter l'instance de l'application Word qui est ouverte

Set Wd = GetObject(, "Word.Application")

'Pointer vers le document ouvert dans cette instance

Set Dc = Wd.documents("NomDuDocumentWord.docx")

'Obtenir l'endroit où est le curseur dans le document Word

Set Plg = Wd.Selection.Range

'Avec la feuille de calcul de l'application Excel

With Worksheets("Feuil1")

'Avec la cellule A1

With ActiveCell

'Compter le nombre de caractères dans la cellule

Nb = Len(.Value)

'Copier dans le presse-papier la cellule

.Copy

End With

End With

'Cette ligne de code insère une espace exactement où est le curseur

Plg.InsertAfter " "

'Se déplacer de 1 caractère vers la droite pour tenir compte

'de l'espace que l'on vient d'ajouter

Plg.Move Unit:=1, Count:=1

'Colle le contenu du presse-papier avec un lien

'Les paramètres de la ligne de code se lit comme suit:

Plg.PasteExcelTable LinkedToExcel:=False, WordFormatting:=True, RTF:=True

'Se déplacer de la longueur du texte ajouté

Plg.Move Unit:=1, Count:=Nb

'Insère un espace

Plg.InsertAfter " "

'Se déplace de 1 caractère

Plg.Move Unit:=1, Count:=1

'Placer le curseur exactement après l'insertion du dernier caractère " "

Plg.Select

'Enlève le pointillé autour de la cellule A1

Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub

Merci de votre aide.

Médéric