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

Question

I have hundreds of cells I need to copy paste from excel into a word table. I have figured out how to insert data (ie a "word table cell = 1" ) within excel VBA > word and that works fine, but my issue is copying a single excel cell into a single word table cell.

My code is currently:

'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

What it currently does is copy the first excel cell, to every single word table cell. When it hits the second excel cell, it overwrites every other word table cell.

Picture below of what is currently happening:

What I would like to happen: (Reads first excel cell, copy pastes to word table cell. - reads second excel cell, copy pastes to second word table cell.

Thanks,

Alex.

Answer 1

This code should do the trick. It worked in my test anyway:

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

I purposely chose different size input and output ranges so that it would demonstrate that functionality.

Excel sheet(input):

Word page (output):

With this method, you have control over whether you want it to read rows then columns, or columns then rows.

Be aware that the UsedRange function does not always return the proper results. There are cases where it will give a larger range than what you may want.