Coller une variable Word dans Excel (depuis Word)

Bonjour à tous,

Après avoir fait différentes recherches, je vois qu'il y a surtout des infos pour ceux qui veulent coller de Excel à Word mais très peu pour faire l'inverse, alors je me lance !

Mon objectif est de créer un tableau excel qui recense les numéros de suivi recommandé de tous les courriers que j'envoie au travail.

Au départ j'ai :

1. Un courrier Word (le nom est variable, il change à chaque nouveau courrier) avec ces 3 variables :

• nom du dossier
• référence
• N° de LRAR (Ligne commençant par LRAR)

2. Un fichier Excel (C:\Users\U3\Documents\SUIVI LRAR.xlsx) avec une colonne pour chacune des variables citées plus haut.

Je cherche à créer une macro depuis mon fichier Word pour coller automatiquement les variables dans une nouvelle ligne sur mon tableau Excel.

J'ai testé l'ouverture du fichier Excel par Macro mais ça ne m'avance pas plus. (je ne souhaite pas faire un copier coller ensuite, mon objectif est de limiter le nombre de clics)

J'imagine que ma macro pourrait commencer par celle qui permet de copier un tableau word dans un autre document word mais il y a beaucoup d'éléments qui ne correspondent pas et je n'ai pas les compétences en rédaction pour les réecrire :

Sub LRAR()

Dim oDocSource As Document

Dim oDocCible As Document

Set xlApp = CreateObject("excel.application")

Dim oTbl1 As Table

Dim Boofound As Boolean

Selection.HomeKey Unit:=wdStory

Selection.Find.ClearFormatting

Set oDocSource = ActiveDocument

With Selection.Find

.Text = "<LRAR> <(*)>"

.Forward = True

.Wrap = wdFindContinue

.Format = False

.MatchCase = False

.MatchWholeWord = False

.MatchAllWordForms = False

.MatchSoundsLike = False

.MatchWildcards = True

End With

Set oDocCible = Documents.Add

Set oTbl1 = oDocCible.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=1)

oTbl1.Rows(1).Cells(1).Range.Text = "LRAR"

oDocSource.Select

Selection.Find.Execute

While Selection.Find.Found

aMotTrouve = Selection.Range.Words(2)

oTbl1.Rows.Add

oTbl1.Rows(oTbl1.Rows.Count).Cells(1).Range.Text = aMotTrouve

Selection.Find.Execute

Wend

End Sub

D'avance merci pour vos réponses !

Bonjour,

Si cela peut servir à quelqu'un :

Option Explicit

Sub MettreAJourDesCellulesDansExcel()

Dim DocEnCours As Document
Dim Chemin As String, Dossier As String, Reference As String, NumeroLrar As String
Dim TableDoc As Table

Dim XlApp As Excel.Application   ' Référencer Microsoft Excel
Dim FichierExcel As Excel.Workbook
Dim TabExcel As Excel.ListObject, LigneExcel As Excel.ListRow ' Correspond à un tableau structuré et à une ligne du tableau

    Set DocEnCours = ActiveDocument
    With DocEnCours
         Chemin = .Path & "\" & "Suivi des LRAR 2026.xlsx" ' A adapter
         Set TableDoc = .Tables(1)
    End With

    Set XlApp = CreateObject("Excel.Application")
    With XlApp
         .Visible = True
          Set FichierExcel = .Workbooks.Open(FileName:=Chemin)
          Set TabExcel = FichierExcel.Sheets("Suivi des LRAR").ListObjects("t_LRAR") ' A adapter
          Set LigneExcel = TabExcel.ListRows.Add
          With LigneExcel  ' Emplacements à adapter
               .Range(1, 1) = Trim(Mid(TableDoc.Cell(2, 2), 1, Len(TableDoc.Cell(2, 2).Range.Text) - 1)) ' Dossier
               .Range(1, 2) = Trim(Mid(TableDoc.Cell(2, 3), 1, Len(TableDoc.Cell(2, 3).Range.Text) - 1)) ' Référence
               .Range(1, 3) = Trim(Mid(TableDoc.Cell(2, 1), 6, Len(TableDoc.Cell(2, 1).Range.Text) - 7)) ' Numero LRAR
          End With
          Set LigneExcel = Nothing
          FichierExcel.Close savechanges:=True
     End With

     XlApp.Quit

     Set XlApp = Nothing: Set FichierExcel = Nothing: Set TabExcel = Nothing
     Set DocEnCours = Nothing: Set TableDoc = Nothing

End Sub