Convert Word tables to Excel
 

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