Copy Disjointed Cells from Excel Table to Word Table Using VBA

Question

I'm trying to copy disjointed cells from an excel document to the cursor location in word and use my predefined table style.

The disjoint copy/paste works nicely in excel when I just copy and paste into the current active worksheet, but as soon as I try to execute the same copy/paste from word, it ends up copying the entire table from top-left all the way to bottom-right, instead of doing the disjointed copy/paste.

I know there are some differences between the individual function from excel VBA to word VBA, but I thought it's possible to get around that by specifying the library when calling functions.

Seen below is a successful disjointed copy:

Successful Disjointed Copy

Here is the functioning excel code, edited for length.

The code within if Copy3 is the interesting part:

Sub GrabExcelTables()

' !Initializing everything

Dim phasesArray As Variant
phasesArray = Array("Scoping", "Umsetzung (Dev)", "Go Live")

With wsFrom

    'Copy schema for tables 1 and 2
    ' !Omitted for length

    'Copy schema for tables 3 and 4
    ' !Omitted for length

    'Copy schema for tables 5 and 6
    If Copy3 Then

        'Iterate through all columns to find which ones are filled
        For colCounter = Left + 1 To Right - 1
            If .Cells(22, colCounter).Value <> "-" Then
                wantedColumn.Add colCounter
            End If
        Next colCounter

        'Initialize RangeToCopy with top left cell of table
        Set RangeToCopy = .Cells(22, Left)

        'Iterate through all rows
        For rowCounter = 22 To 29

            'Only check those rows desired i.e.  part of phasesArray
            If (IsInArray(.Cells(rowCounter, Left).Value, phasesArray) Or rowCounter = 22 Or rowCounter = 29) Then

                'Union row phase header
                Set RangeToCopy = Union(RangeToCopy, .Cells(rowCounter, Left))

                'Add all columns within row that were selected as filled earlier
                For Each col In wantedColumn
                    Set RangeToCopy = Union(RangeToCopy, .Cells(rowCounter, col))
                Next col

                'Union final total column
                Set RangeToCopy = Union(RangeToCopy, .Cells(rowCounter, Right))
            End If
        Next rowCounter
    End If

    'Copy schema for table 7
    ' !Omitted for length

    'Copy range
    RangeToCopy.Copy
    .Range("A42").PasteSpecial Paste:=xlValues

End With



Set RangeToCopy = Nothing



End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

Now pretty much the same code except adapted to word VBA, again edited for length:

Sub GrabExcelTables()

' !Initializing everything

Dim phasesArray As Variant
phasesArray = Array("Scoping", "Umsetzung (Dev)", "Go Live")


'specify the workbook to work on
WorkbookToWorkOn = ActiveDocument.Path & "\Kalkulationssheet_edit.xlsx"


Set oXL = CreateObject("Excel.Application")

On Error GoTo Err_Handler

'Open the workbook
Set oWB = Workbooks.Open(FileName:=WorkbookToWorkOn)

Set wsFrom = oWB.Sheets(7)

' !Initializing everything

With wsFrom

    'Copy schema for tables 1 and 2
    ' !Omitted for length

    'Copy schema for tables 3 and 4
    ' !Omitted for length

    'Copy schema for tables 5 and 6
    If Copy3 Then

        'Iterate through all columns to find which ones are filled
        For colCounter = Left + 1 To Right - 1
            If .Cells(22, colCounter).Value <> "-" Then
                wantedColumn.Add colCounter

                'MsgBox "Wanted Column: " & colCounter

            End If
        Next colCounter

        'Initialize RangeToCopy with top left cell of table
        Set RangeToCopy = .Cells(22, Left)

        'Iterate through all rows
        For rowCounter = 22 To 29

            'Only check those rows desired i.e.  part of phasesArray
            If (IsInArray(.Cells(rowCounter, Left).Value, phasesArray) Or rowCounter = 22 Or rowCounter = 29) Then

                'MsgBox "rowCounter: " & rowCounter & "cell value: " & .Cells(rowCounter, Left).Value

                'Union row phase header
                Set RangeToCopy = Excel.Union(RangeToCopy, .Cells(rowCounter, Left))

                'Add all columns within row that were selected as filled earlier
                For Each col In wantedColumn
                    Set RangeToCopy = Excel.Union(RangeToCopy, .Cells(rowCounter, col))
                Next col

                'Union final total column
                Set RangeToCopy = Excel.Union(RangeToCopy, .Cells(rowCounter, Right))
            End If
        Next rowCounter

    End If

    'Copy schema for table 7
    ' !Omitted for length

    'Copy range
    'MsgBox RangeToCopy.Text
    'MsgBox RangeToCopy.Value
    RangeToCopy.Copy
    '.Range("A42").PasteSpecial Paste:=xlValues

End With

'MsgBox Range.Text
Selection.PasteExcelTable False, True, False
'Selection.PasteSpecial DataType:=wdPasteRTF
Selection.MoveUp Unit:=wdLine, count:=11
Selection.MoveDown Unit:=wdLine, count:=1
ActiveWindow.View.ShowXMLMarkup = wdToggle
ActiveDocument.ToggleFormsDesign
Selection.Tables(1).Style = "StandardAngebotTable"


'Release object references
oWB.Close SaveChanges:=True
Set oWB = Nothing

Set RangeToCopy = Nothing

oXL.Quit
Set oXL = Nothing

'quit
Exit Sub

' Error Handler

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

The changing of table style and pasting into the correct position works exactly as expected, but using the exact same code from excel with Excel library calls doesn't function as expected.

Instead of getting a nice disjointed copy/paste, I always copy past the entire table, or more specifically a rectangle from the top-left most cell to the bottom-right most cell.

Does anyone know a way to force word vba to use the same copy/paste commands from excel? The other idea I had was to just fill the table cell for cell, but that would require quite a bit of code restructuring and would be nice if I didn't need to do that. Thanks for the help!

Copy Disjointed Cells from Excel Table to Word Table Using VBA

Answers (1)

Related Questions