Excel VBA using word table

Option Explicit

Sub MergeTables()
Dim srcDoc As Document, dstDoc As Document
Dim srcTbl1 As Table, srcTbl2 As Table, dstTbl As Table
Dim rng As Range, sTmp As String
Dim r As Long, rc As Long

'on error got error handler
On Error GoTo Err_MergeTables

'this document
Set srcDoc = ThisDocument
'table 1
Set srcTbl1 = srcDoc.Tables(1)
'table 2
Set srcTbl2 = srcDoc.Tables(2)

'add new document
Set dstDoc = Documents.Add
'add table in to new document
Set dstTbl = dstDoc.Tables.Add(dstDoc.Range, srcTbl1.Rows.Count, srcTbl1.Columns.Count)

'get row count
rc = srcTbl1.Rows.Count
'go through the collection of rows
'start from 2. row, ignore header ;)
For r = 2 To rc
    'get ID from column 1
    Set rng = srcTbl1.Cell(r, 1).Range
    dstTbl.Cell(r, 1).Range.Text = rng.Text
    'find ID in the 2. table and get some information
    sTmp = FindIDAndGetInfo(rng.Text)
    'insert info...
    dstTbl.Cell(r, 2).Range.Text = sTmp
Next


Exit_MergeTables:
    On Error Resume Next
    'clean up ;)
    Set rng = Nothing
    Set dstTbl = Nothing
    Set srcTbl2 = Nothing
    Set srcTbl1 = Nothing
    Exit Sub

Err_MergeTables:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_MergeTables

End Sub


Function FindIDAndGetInfo(sID As String) As String
Dim sRetVal As String

'you need to implement the body of function
'tip: go through the collection of cells ;)

FindIDAndGetInfo = sRetVal
End Function