将单元格数据从excel复制到word VBA

Question

我有数百个单元格，需要将 Excel 中的粘贴复制到单词表中。 我已经想出了如何在 excel VBA > word 中插入数据（即 "word table cell = 1" ）并且工作正常，但我的问题是将单个 excel 单元格复制到单个单词表单元格中。

我的代码目前是：

'Do the For Loops here, WIP
For Each Cell In ActiveSheet.UsedRange.Cells
  'do some stuff

  For Each oRow In wdDoc.Tables(1).Rows
    For Each oCell In oRow.Cells

     ' Set sCellText equal to text of the cell.
     ' Note: This section can be modified to suit
     ' your programming purposes.
  If ((oCell.Column.Index Mod 2) = 0) Then

  Else
    'counter = counter + 1

    'oCell.Range.Text = ThisWorkbook.Sheets(1).Cells(1, 2).Value
    oCell.Range.Text = Cell

  End If

Next oCell
Next oRow
Next

它目前所做的是将第一个 excel 单元格复制到每个单词表单元格。 当它击中第二个 excel 单元格时，它会覆盖所有其他单词表格单元格。

下图是目前正在发生的事情：

我想发生什么：（读取第一个 excel 单元格，将粘贴复制到单词表单元格。 - 读取第二个 excel 单元格，将粘贴复制到第二个单词表单元格。

谢谢，

亚历克斯。

Answer 1

这段代码应该可以解决问题。 无论如何，它在我的测试中有效：

Dim firstRow As Integer
Dim firstColumn As Integer
Dim numRows As Integer
Dim numColumns As Integer

Dim uRange As Range

Set uRange = ActiveSheet.UsedRange
firstRow = uRange.Row
firstColumn = uRange.Column
numRows = uRange.Rows.Count
numColumns = uRange.Columns.Count

Dim rowNumber As Integer
Dim columnNumber As Integer
Dim tableRow As Integer
Dim tableColumn As Integer
tableRow = 1
tableColumn = 1

Dim tableRows As Integer
Dim tableColumns As Integer
tableRows = doc.Tables(1).Rows.Count
tableColumns = doc.Tables(1).Columns.Count

For rowNumber = firstRow To firstRow + numRows - 1
    For columnNumber = firstColumn To firstColumn + numColumns - 1
        doc.Tables(1).Cell(tableRow, tableColumn).Range.Text = Cells(rowNumber, columnNumber).Value
        tableColumn = tableColumn + 2
        If tableColumn > tableColumns Then
            tableColumn = 1
            tableRow = tableRow + 1
        End If
        If tableRow > tableRows Then
            Exit Sub
        End If
    Next
Next

我特意选择了不同大小的输入和输出范围，以便展示该功能。

Excel表（输入）：

Word 页面（输出）：

使用此方法，您可以控制是希望它先读取行然后读取列，还是先读取列然后读取行。

请注意， UsedRange函数并不总是返回正确的结果。 在某些情况下，它会提供比您想要的更大的范围。