Подобные вещи неоднократно обсуждались на различных форумах, в том числе и здесь.См., Например:
код VBA, который копирует таблицы из нескольких файлов Word в отдельные листы в Excel Excel, называя таблицу именем документа Word?
https://www.excelguru.ca/forums/showthread.php?8900-Help-with-VBA-to-extract-data-from-Word-to-Excel&p=36586&viewfull=1#post36586
Для одного документа Word вы можете использовать код, подобный следующему:
Sub GetTableData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document, wdTbl As Word.Table
Dim strFile As String, WkSht As Worksheet, r As Long
Set WkSht = Activesheet
'Disable any Word Alerts
wdApp.DisplayAlerts = wdAlertsNone
'Disable any auto macros in the documents being processed
wdApp.WordBasic.DisableAutoMacros
strFile = "Filename & path"
Set wdDoc = wdApp.Documents.Open(FileName:=strFile, ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
With wdDoc
WkSht.Name = Split(.Name, ".doc")(0)
For Each wdTbl In .Tables
With wdTbl.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[^13^l]"
.Replacement.Text = "?"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
r = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
If r > 1 Then r = r + 2
wdTbl.Range.Copy
WkSht.Paste Destination:=WkSht.Range("A" & r)
Next
WkSht.UsedRange.Replace What:="?", Replacement:=Chr(10), LookAt:=xlPart, SearchOrder:=xlByRows
.Close SaveChanges:=False
End With
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub
Обратите внимание, как целые таблицы копируются и вставляются без обхода вашего подхода к ячейкам.FWIW, ни разрывы абзацев Word, ни разрывы строк в Word не могут быть скопированы и вставлены непосредственно в одну ячейку Excel;они оба интерпретируются как указание на конец содержимого ячейки в Excel.
Также обратите внимание, что с помощью приведенного выше кода вам необходимо указать путь и имя документа.