Ok, thanks for the replies, my bad on the minimal desc.
What I have is a Word doc with a table repeated multiple times. each
table has 8 cells, same cell header, different text data in each. I
want a macro to scan the word doc for all the tables, and take 6 of the
8 cells out of each table and export them to a new Excel worksheet,
with each row in that worksheet representing the table that was
scanned, and each column the cell data (so, 6 columns). The rows
appearing in excel would depend on the number of tables in the word doc
that was scanned.
In other words,
one word doc = one excel file
one table in that word doc = one row in the excel file
Here is my frankenstein code so far:
__________________________________________
Public Sub ScanDocumentForTable(sDocPath As String, wdDocName As
String)
Dim WordDocument As Object
Dim wdApp As Object
Set wdApp = GetObject("", "Word.Application")
DoEvents
wdApp.Application.Documents.Open sDocPath & wdDocName & ".doc"
wdApp.Application.Visible = False
DoEvents
If wdApp.ActiveDocument.Tables.Count >= 3 Then
Dim tblNumber As Integer
For tblNumber = 3 To wdApp.ActiveDocument.Tables.Count
If Left(wdApp.ActiveDocument.Tables(tblNumber), 9) = "Step Type" Then
wdApp.ActiveDocument.Tables(tblNumber).Range.Copy
ActiveDocument.Tables(1).Cell(3, 1)
ActiveDocument.Tables(1).Cell(3, 1)
ActiveDocument.Tables(1).Cell(3, 2)
ActiveDocument.Tables(1).Cell(7, 1)
ActiveDocument.Tables(1).Cell(1, 2)
ActiveDocument.Tables(1).Cell(3, 3)
ActiveDocument.Tables(1).Cell(3, 4)
Exit For
End If
Next tblNumber
End If
End Sub
------------------------------
Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
ExcelSheet.Application.Visible = False
DoEvents
ExcelSheet.ActiveSheet.PasteSpecial Format:="HTML", Link:=False,
DisplayAsIcon:=False, NoHTMLFormatting:=True
ExcelSheet.ActiveSheet.Rows("1:1").Font.Bold = True
ExcelSheet.Application.Cells.Font.Name = "Courier New"
ExcelSheet.Application.Cells.Font.Size = 10
ExcelSheet.Application.Cells.EntireColumn.Autofit
ExcelSheet.SaveAs sDocPath & wdDocName & ".xls"
ExcelSheet.Application.Quit
wdApp.Application.Quit
Set ExcelSheet = Nothing
Set wdApp = Nothing
Exit For
End If
Next tblNumber
End If
End Sub