Tables Selective Merge

[Giri]

Hi I am trying to write a macro for a word problem. I have 2 tables like below:

Heading 1 Heading 1
Name
Abcdef abcdef abcdef abcdef
Data
Data
Data
Data


1 Xyz Juhdfjjknb
2 Def Dijwhcjco
3 Hgt Jascnjxnksjnx
4 Wxy Osuhchc ciwjqsdioj


I have to take the first 2 rows of the first table and merge it with the
first 3 columns of the second table in a new table with 5 columns. This is
tobe repeated 400 times with tables with similar data. The final table should
be like below:

Heading 2 Heading 2 Heading 2 Heading 2 Heading 2
Name Abcdef abcdef abcdef abcdef 1 Xyz Juhdfjjknb
2 Def Dijwhcjco
3 Hgt Jascnjxnksjnx
4 Wxy Osuhchc

Any ideas about how this could be done?

Giri

 

[Doug Robbins - Word MVP]

You sample of what you should end up with does not match your description.
Did you mean it to be:

Heading 1 Heading 2 Heading 3 Heading 4 Heading 5
Name Abcdef (etc.) 1 Xyz (etc.) 2 Def (etc.) 3 Hgt (etc)



--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[David Sisson]

This is to be repeated 400 times with tables with similar data.

Is this repeated in the same document or in 400 documents?

This merges into a new document. You said "in a new table", but you
didn't say if it had to be in the same document. I assumed not.

This seems to work, however, I've got a feeling you will need
something more dynamic.

Sub MergeTables()

Dim aDoc As Document
Dim SrcDoc As Document
Dim tbl1 As Table
Dim tbl2 As Table
Dim Tbl1Rng As Range
Dim Tbl2Rng As Range
Dim A As Integer
Dim B As Integer
Dim C As Integer

Dim MyText$

Set aDoc = ActiveDocument
Set tbl1 = aDoc.Tables(1)
Set tbl2 = aDoc.Tables(2)

Set SrcDoc = Documents.Add

SrcDoc.Range.InsertAfter _
"HD2,HD2,HD2,HD2,HD2" & vbCr

'First Row
For A = 2 To 3
Set Tbl1Rng = tbl1.Cell(A, 1).Range
'Remove end of cell marker
Tbl1Rng.MoveEnd wdCharacter, -1
MyText$ = MyText$ & "," & Tbl1Rng
Next
'Remove first comma
MyText$ = Mid(MyText$, 2, Len(MyText$))

For C = 1 To 3
Set Tbl2Rng = tbl2.Cell(1, C).Range
Tbl2Rng.MoveEnd wdCharacter, -1
MyText$ = MyText$ & "," & Tbl2Rng
Next

SrcDoc.Range.InsertAfter MyText$ & vbCr ' Row 1

'Subsequent rows
For B = 2 To 4
MyText$ = ","
For C = 1 To 3
Set Tbl2Rng = tbl2.Cell(B, C).Range
Tbl2Rng.MoveEnd wdCharacter, -1
MyText$ = MyText$ & "," & Tbl2Rng
Next
MyText$ = Mid(MyText$, 2, Len(MyText$))
SrcDoc.Range.InsertAfter "," & MyText$ & vbCr
Next

Set aDoc = Nothing
Set Tbl1Rng = Nothing
Set Tbl2Rng = Nothing

With SrcRng.Range
.ConvertToTable ","
End With
End Sub

 

[Giri]

Thanks,

Davd and Doug. The data (400 different tables) are from the same document
and a new table is to be created in a different document.

This was exactly what I was looking for.