summarize multiple word tables to excel

Hello,

I have al little issue :) i need to import multiple word file's with tabels each word table has 2 collumns and 38 rows in to a excel sheet. The collumn 1 has names and collumn 2 numbers.

now the tricky part haha. If the imported names are the same thats fine but the numbers need to be added up.

can someone help me please.

There are numerous examples of code for extract content from Word tables in the Integration/Automation of Office Applications forum, to which I've moved your thread. See, for example: www.vbaexpress.com/forum/showthread.php?61658-Extract-table-data-from-multiple-Word-documents-to-one-Excel-sheet
see also: https://www.excelguru.ca/forums/show...-Word-to-Excel

I have no idea what you mean by:

Quote:

---

Originally Posted by lowej

If the imported names are the same thats fine but the numbers need to be added up.

---

Thank you for the reply.

What i mean is the word table in collumn 1 has names like richard or peter, collumn 2 number like 200, 400.
Example of how i would liek it to be:

word 1

Column1	Column2
peter	100
richard	100
word 2
column1 column 2
fred	200
peter	200
paul	100
richard	100

when these two are imported in to excel it should look like:

Column1 Column2
fred 200
peter 300
paul 100
richard 200

That's an entirely different proposition from what your first post implies. It seems you don't want each table imported in its own right but, instead, want to create a tally of the 'like' entries from the table(s) in each document.

aa oke sorry if i explained it wrong :) and i didn't know it was called tally haha

but is that possible to do ?

Does each document have the data in the same table? If so, which one? Do the Word tables have a header row?

Yes each word document has the same table (table number 2 in the word document). Also the word tables have headers. Header 1: Voeding Header 2: Gram

Try the following Excel macro:

Code:

---

Sub TallyTableData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document, wdRng As Word.Range
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet, r As Long
strFolder = GetFolder: If strFolder = "" Then GoTo ErrExit
Set WkSht = ActiveSheet: r = 1
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
  With wdDoc
    If .Tables.Count > 1 Then
      Set wdRng = .Tables(2).Range
      If r > 1 Then wdRng.Start = wdRng.Tables(1).Rows(2).Range.Start
      wdRng.Copy
      WkSht.Paste Destination:=WkSht.Range("A" & r)
      r = r + wdRng.Rows.Count + 1
    End If
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
With WkSht
  .UsedRange.Sort Key1:=.Columns("A"), Order1:=xlAscending, Header:=xlNo
  For r = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
    If .Range("A" & r - 1).Value = .Range("A" & r).Value Then
      If IsNumeric(.Range("B" & r).Value) Then .Range("B" & r - 1).Value = .Range("B" & r).Value + .Range("B" & r - 1).Value
      .Rows(r).EntireRow.Delete
    End If
  Next
End With
ErrExit:
wdApp.Quit
Set wdRng = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing: Set WkBk = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function

---

The macro has a folder browser, so all you need do is select the folder to process.

Yes thats works!! thanks!!!

i did had to add one thing and that was:

Set WkSht = ActiveSheet