Экспорт данных из Excel в слово по нескольким столбцам

Question

Привет! Я использую следующий код для копирования значений из таблицы Excel в предварительно определенную таблицу в слове. Ниже работает нормально для 1 столбца, как я могу получить его для передачи данных для всех 5 столбцов? Спасибо

Sub ExportData()

Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdCell As Word.Cell
Dim i As Long
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnData As Range
Dim vaData As Variant

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Sheet1")

With wsSheet
    Set rnData = .Range("A1:E10")
End With

'Add the values in the range to a one-dimensional variant-array.
vaData = rnData.Value

'Here we instantiate the new object.
Set wdApp = New Word.Application

'Here the target document resides in the same folder as the workbook.
Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\Test.doc")

'Import data to the first table and in the first column of a table in Microsoft Word.
For Each wdCell In wdDoc.Tables(1).Columns(1).Cells
    i = i + 1
    wdCell.Range.Text = vaData(i, 1)
Next wdCell

'Save and close the document.
With wdDoc
    .Save
    .Close
End With

'Close the hidden instance of Microsoft Word.
wdApp.Quit

'Release the external variables from the memory
Set wdDoc = Nothing
Set wdApp = Nothing
MsgBox "The data has been transfered to Test.doc, vbInformation"

End Sub

Answer 1

Так что это немного поздний ответ, но попробуйте следующее:

Добавить в объявления

Dim j As Long

Удалить из деклараций

Dim rnData As Range

Изменение

With wsSheet
    Set rnData = .Range("A1:E10")
End With

'Add the values in the range to a one-dimensional variant-array.
vaData = rnData.Value

до

ReDim vaData(1 To 10, 1 To 5)

With wsSheet
    vaData = .Range("A1:E10")
End With

и изменить

'Import data to the first table and in the first column of a table in Microsoft Word.
For Each wdCell In wdDoc.Tables(1).Columns(1).Cells
    i = i + 1
    wdCell.Range.Text = vaData(i, 1)
Next wdCell

до

For j = 1 To 5
    i = 0

    For Each wdCell In wdDoc.Tables(1).Columns(j).Cells
        i = i + 1
        wdCell.Range.Text = vaData(i, j)
    Next wdCell

Next j

Коррекция

MsgBox "The data has been transferred to Test.doc", vbInformation