vbams-wordword-table

Combine or merge word table with condition


The word document containing multiple tables. If any table having rows equal to value x (eg. 12) then delete first row and cut that table and paste it below the last row of previous table (means join the selected table with previous table at the end). The below code delete the first row but pasting the same table above the selected table. I have used copy in below code instead of cut.

Private Sub MergeTables()
Dim tbl As Table, r As Row
Dim i As Integer

With ActiveDocument
For Each tbl In ActiveDocument.Tables
    If tbl.Rows.Count = 12 Then
    With tbl
    .Rows(1).Delete
    tbl.Range.Copy 'Need to paste below last row of previous table

    'tbl.Range.GoTo What:=wdGoToTable, Which:=wdGoToPrevious 'Pasting above the same table
    tbl.Range.PasteAndFormat wdFormatOriginalFormatting
    End With
    End If

Next tbl
End With
End Sub

Solution

  • Provided the first table's row count <> 12:

    Sub MergeTables()
    Dim TblSrc As Table, TblTgt As Table, Rng As Range
    For Each TblSrc In ActiveDocument.Tables
        With TblSrc
          If .Rows.Count = 12 Then
            .Rows(1).Delete
            Set Rng = TblTgt.Range
            Rng.Collapse wdCollapseEnd
            Rng.FormattedText = .Range.FormattedText
            .Delete
          Else
            Set TblTgt = TblSrc
          End If
        End With
    Next
    End Sub