Convert Word Tables to Excel

[Giri]

Hi,

I am trying to write a macro to convert some of my word table to excel. The
code I am using is below. Could anyone suggest how to convert to excel?

Also, the code is picking up from a single table. I want it to pick up from
consequent tables as well. How do I do that?


Sub MergeTables()
'
' MergeTables Macro
' Macro created 1/18/2008 by PENNDOT
'
Dim aDoc As Document
'Dim aDoc As Excel
Dim SrcDoc As Document
'Dim SrcDoc As Excel.Application
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 D As Integer


Dim MyText$

Set aDoc = ActiveDocument
Set SrcDoc = ActiveDocument
'Set SrcDoc = GetObject(, "Excel.Application")
Set tbl1 = aDoc.Tables(1)
Set tbl2 = aDoc.Tables(2)

Set SrcDoc = Documents.Add

SrcDoc.Range.InsertAfter _
"Scenario,Description,Step,Action,Results" & vbCr
'First Row
For A = 1 To 2
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

 

[Helmut Weber]

Hi Giri,

your code doesn't make much sense to me.

Anyway,
to transfer a Word-table to Excel,
you just copy the table and paste it
into an Excel Worksheet.

To copy a single cell or some adjacent cells
from Word to Excel,
it is just the same.

See in addition:
http://word.mvps.org/FAQs/InterDev/ControlXLFromWord.htm

--

Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Vista Small Business, Office XP