Please, try the next code:
Sub JoinTables()
Dim sh As Worksheet, T1 As ListObject, T2 As ListObject, T3 As ListObject
Dim arr1, arr2, arr3, arrHead, dict As Object, i As Long, iRow As Long, iCol As Long
Set sh = ActiveSheet 'use here the necessary sheet
Set T1 = sh.ListObjects("Table1") 'use here your first table name
Set T2 = sh.ListObjects(2) 'use here your second table name
arr1 = T1.DataBodyRange.Value 'put the data body range in an array
arr2 = T2.DataBodyRange.Value
arrHead = T1.HeaderRowRange.Value 'put thea header in an array
Set dict = CreateObject("Scripting.Dictionary") 'create a dictionary
For i = 1 To UBound(arr1)
dict(arr1(i, 1)) = arr1(i, 2) 'input all in the dictionary
Next i
For i = 1 To UBound(arr2) 'process the second table, too
If Not dict.Exists(arr2(i, 1)) Then
dict(arr2(i, 1)) = arr2(i, 2) 'create a new key
Else
dict(arr2(i, 1)) = dict(arr2(i, 1)) + arr2(i, 2) 'add to the existing key
End If
Next i
'interesting way of obtaining an array by other (one column) arrays combination:
arr3 = Application.Transpose(Array(dict.Keys, dict.Items)) 'combine the two array !!!
iRow = T1.HeaderRowRange.row 'the row where the new Table will be created
iCol = T2.HeaderRowRange.Column + T2.HeaderRowRange.Columns.count 'column of the new table
sh.Range(sh.cells(iRow, iCol + 1), sh.cells(iRow, iCol + 2)).Value = arrHead 'put the header
sh.cells(iRow, iCol + 1).Offset(1).Resize(UBound(arr3), UBound(arr3, 2)).Value = arr3 'put the content
sh.cells(iRow, iCol + 1).CurrentRegion.Select 'select it to become a table in the next code line
Set T3 = sh.ListObjects.Add 'create the new table
'Copy the second column format in the new created table
T3.DataBodyRange.Columns(2).NumberFormat = T1.DataBodyRange.Columns(2).NumberFormat
End Sub
Edited to ad a version working with ranges:
Sub MergeRanges()
Dim sh As Worksheet, lastR1 As Long, lastR2 As Long, firstCol1 As Long, firstCol2 As Long
Dim arr1, arr2, arr3, arrHead, dict As Object, i As Long, iRow As Long, iCol As Long
Set sh = ActiveSheet 'use here the necessary sheet
firstCol1 = 7: firstCol2 = 10 'where are the first column of the two ranges
iRow = 14 ' the row where the header is
lastR1 = sh.cells(rows.count, firstCol1).End(xlUp).row
lastR2 = sh.cells(rows.count, firstCol2).End(xlUp).row
arr1 = sh.Range(sh.cells(iRow + 1, firstCol1), sh.cells(lastR1, firstCol1 + 1)).Value 'put the range in an array
arr2 = sh.Range(sh.cells(iRow + 1, firstCol2), sh.cells(lastR2, firstCol2 + 1)).Value
arrHead = sh.Range(sh.cells(iRow, firstCol1), sh.cells(iRow, firstCol1 + 1)).Value 'put thea header in an array
Set dict = CreateObject("Scripting.Dictionary") 'create a dictionary
For i = 1 To UBound(arr1)
dict(arr1(i, 1)) = arr1(i, 2) 'input all in the dictionary
Next i
For i = 1 To UBound(arr2)
If Not dict.Exists(arr2(i, 1)) Then
dict(arr2(i, 1)) = arr2(i, 2) 'create a new key
Else
dict(arr2(i, 1)) = dict(arr2(i, 1)) + arr2(i, 2) 'add to the existing key
End If
Next i
arr3 = Application.Transpose(Array(dict.Keys, dict.Items)) 'combine the two array !!!
iCol = firstCol2 + 3 'column of the new table
sh.Range(sh.cells(iRow, iCol + 1), sh.cells(iRow, iCol + 2)).Value = arrHead 'put the header
With sh.cells(iRow, iCol + 1).Offset(1).Resize(UBound(arr3), UBound(arr3, 2))
.Value = arr3 'put the content
.Columns(2).NumberFormat = sh.cells(iRow + 1, firstCol1 + 1).NumberFormat
End With
End Sub