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