Hi,
Below is the code to convert word tables to word. But I am trying to convert
them into Excel. I have not been successful so far. Can somebody tell me
where I am goign wrong or how to do it.
Sub MergeTables()
'
' MergeTables Macro
' Macro created 1/18/2008 by PENNDOT
'
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 SrcDoc = 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, 2).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 SrcDoc.Range
.ConvertToTable ","
End With
End Sub
Thank You