importer plusieurs tableau word en gérant les sauts de lignes

Sub tableauSansLignes()
 
Dim WordDoc As Object
Dim i As Integer, j As Integer
Dim Wb As Workbook
Dim Cible As Variant
Dim Fichier As Variant
 
 
    'affichage boite de dialogue pour choisir un document Word
Fichier = Application.GetOpenFilename("Text Files (*.doc*), *.doc*")
If Fichier = False Then Exit Sub
 
    Set WordDoc = GetObject(Fichier)
    Set Wb = Workbooks.Add(1)
    For i = 1 To WordDoc.Tables(1).Rows.Count
        For j = 1 To WordDoc.Tables(1).Columns.Count
            Cible = WordDoc.Tables(1).Columns(j).Cells(i)
 
            Sheets(1).Cells(i, j) = _
            Application.WorksheetFunction.Substitute(Cible, vbCr, vbLf)
            Sheets(1).Cells(i, j) = _
            Left(Sheets(1).Cells(i, j), Len(Sheets(1).Cells(i, j)) - 1)
        Next j
    Next i
     Wb.ActiveSheet.Range("A1").Select
    Wb.ActiveSheet.Paste
 
    Application.CutCopyMode = False
 
 
    Application.Dialogs(xlDialogSaveAs).Show
 
End Sub