Как разработчик, какие изменения или установки, Вы вносите в ванильной системе OS X?

Для того, чтобы заставить это работать, был необходим ряд корректировок:

1. On Error Resume Next был удален. Это никогда не должно использоваться для всего макроса - все, что он будет делать, это скрывать ошибки, которые сообщат вам, что происходит не так. Если ошибки происходят регулярно, то нужно что-то исправлять! Это может быть использовано в особых случаях, но обработка ошибок должна быть снова включена. Я не вижу особого случая в этом коде.

2. Как Word, так и Excel используют Range, поэтому важно указать , что означает диапазон . Это также важно в Excel, в одиночку. Опираясь на VBA , угадать , в каком листе находится диапазон, может привести к неожиданным результатам. По этой причине объект Worksheet объявляется и создается для активной рабочей таблицы. Этот объект - ws - затем используется во всем коде для четкой идентификации всех Range объектов в Excel.

3. Поскольку заголовки столбцов в Excel нужно писать только один раз, этот код был перемещен из цикла. Кроме того, первый столбец не помечен на предоставленном вами снимке экрана (REQ). Поэтому метки должны начинаться со столбца B, а не со столбца A - соответственно, эти координаты диапазона были изменены.

4. Всегда сложно работать с таблицами Word, в которых есть объединенные ячейки (первый столбец на снимке экрана). Таким образом, код для получения REQ перемещен за пределы цикла ячейки таблицы и явно ссылается на строку 1, столбец 1.

5. Остальная часть данных, подлежащих передаче, находится только в столбце 3, поэтому нет необходимости циклически обрабатывать столбцы, только строки. Спецификатор столбца для диапазона Excel был изменен для использования irow + 1, поскольку это дает правильный результат.

6. Cell() method in Word is: .Cell (rowIndex, colIndex) `- параметры меняются местами в коде, размещенном в вопросе.

Следующий код работает для меня в моих тестах:

Option Explicit

Sub ImportWordTable()
    Dim wdDoc As Object
    Dim wdFileName As Variant
    Dim tableNo As Integer 'table number in Word
    Dim iRow As Long 'row index in Excel
    Dim iCol As Integer 'column index in Excel
    Dim resultRow As Long
    Dim resultCol As Long
    Dim tableStart As Integer
    Dim tableTot As Integer
    Dim ws As Worksheet

    'On Error Resume Next

    Set ws = ActiveSheet
    ws.Range("A:AZ").ClearContents

    wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
    "Browse for file containing table to be imported")
    If wdFileName = False Then Exit Sub '(user cancelled import file browser)

    Set wdDoc = GetObject(wdFileName) 'open Word file

    With wdDoc
        tableNo = wdDoc.Tables.Count
        tableTot = wdDoc.Tables.Count
        If tableNo = 0 Then
            MsgBox "This document contains no tables", _
            vbExclamation, "Import Word Table"
        ElseIf tableNo > 1 Then
            tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
            "Enter the table to start from", "Import Word Table", "1")
        End If
        resultRow = 2
        With ws
            .Range("B1") = "Description"
            .Range("B1").Font.Bold = True
            .Range("C1") = "Source"
            .Range("C1").Font.Bold = True
            .Range("D1") = "Rationale"
            .Range("D1").Font.Bold = True
        End With
        For tableStart = tableNo To tableTot
            With .Tables(tableStart)
                'copy cell contents from Word table cells to Excel cells
                '''REQ
                ws.Cells(resultRow, 1) = WorksheetFunction.Clean(.Cell(1, 1).Range.Text)
                For iRow = 1 To .Rows.Count
                    'For iCol = 1 To .Columns.Count
                     ws.Cells(resultRow, iRow + 1) = WorksheetFunction.Clean(.Cell(iRow, 3).Range.Text)
                    'Next iCol
                    resultRow = resultRow
                Next iRow
            End With
            resultRow = resultRow + 1
        Next tableStart
    End With
End Sub