Mise en page en Vb

Sub test()
   
' Ajouter la référence à Microsoft Word XX.X Object Library

Dim WordApp As New Word.Application
Dim WordDoc As Word.Document
Dim wsh As Worksheet
Dim C As Range
Dim Doc As String, Txt As String, Txt2 As String, Bal As String
Dim Deb As Long, Fin As Long
Const BalA As String = "title"
   
Set wsh = Worksheets("Feuil4")
With wsh
  .Cells.Clear
  'chemin fichier word en entrée choisis par l'user
  fichier = ThisWorkbook.Path & "\test.doc"
  'lire le fichier Word
  Set WordDoc = WordApp.Documents.Open(fichier)
  Doc = WordDoc.Range
  WordDoc.Close
  WordApp.Quit
  Set WordDoc = Nothing
  Set WordApp = Nothing
  'destination
  Set C = .Range("A2")
  'initialisation pointeur
  Deb = 1
  'chercher les textes balisés
  Do
    Deb = InStr(Deb, Doc, "[") + 1
    Fin = InStr(Deb, Doc, "]")
    If Deb = 1 Or Fin = 0 Then Exit Do
    Bal = Mid(Doc, Deb, Fin - Deb)
    Deb = Fin + 1
    Fin = InStr(Deb, Doc, "& Bal & "")
    If Fin > 0 Then
      Txt = Mid(Doc, Deb, Fin - Deb)
      'entete de colonne cad bal
      If Bal = BalA Then
        C.Value = Txt
        .Columns.AutoFit
        Set C = C.Offset(1)
        Txt2 = ""
      Else
        Txt2 = IIf(Txt2 = "", Txt, Txt2 & vbLf & Txt)
        C.Offset(-1, 1).Value = Txt2
        .Columns.AutoFit
      End If
    End If
  Loop
  .Rows.AutoFit
End With
  
End Sub