Экспорт данных из 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