如何把多个word文件的表格汇总到一个表格里

ct阿田

目前村里有100个人申请交通补贴，有100个word文件，每个文件都有一个表格，格式都是一样的，内容不一样，例如户主、家庭信息、银行卡等等。

如何把100个word的表格内容汇总到一个表格里面，提取姓名、地址、姓名、银行卡、身份证，务工地址等等，汇总的表格可以是excel，也可以是word，有大佬救救小弟吗

ct阿田

word本人只会用邮件合并，现在这种情况有点像反向的邮件合并，把多个同格式的word表格数据汇总到一个数据表里面去，有大神会操作吗，有没有宏可以实现这个功能哈，哪怕以后碰见这种情况也可以解决

jiangxiaoyun

word vba区域已经有很多代码了，搜搜就能拿来用

zhanglei1371

问问chatgpt，不到一天就搞定了

zpy2

https://club.excelhome.net/forum.php?mod=viewthread&tid=1671899&mobile&_dsign=51b67d08

413191246se

楼主，你需要重新提供一下附件，将要提取的数据设置为红色，这样就好办了！

ct阿田

413191246se 发表于 2024-7-29 20:55
楼主，你需要重新提供一下附件，将要提取的数据设置为红色，这样就好办了！

谢谢你的建议，已经重新上传附件了

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, br, j&, r&, wdApp As Object, strFileName$, strPath$
   
    Application.ScreenUpdating = False
   
    ReDim ar(1 To 10 ^ 3, 1 To 9)
    br = Array(2, 4, 6, 10, 12, 16, 18, 20)
   
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err <> 0 Then
        Set wdApp = CreateObject("Word.Application")
        'wdApp.Visible = True
    End If
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = Dir(strPath & "*.doc")
    Do Until strFileName = ""
        With wdApp.documents.Open(strPath & strFileName)
            With .Tables(1)
                r = r + 1
                For j = 0 To UBound(br)
                    ar(r, j + 1) = Left(.Range.Cells(br(j)).Range.Text, Len(.Range.Cells(br(j)).Range.Text) - 1)
                Next j
            End With
            .Close False
        End With
        strFileName = Dir
    Loop
        
    Cells.Clear
    If r Then [A1].Resize(r, UBound(ar, 2)) = ar
   
    If Err <> 0 Then wdApp.Quit
    Set wdApp = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

没有过多的数据，请自行验证。。。

ct阿田

gwjkkkkk 发表于 2024-7-30 21:43
没有过多的数据，请自行验证。。。

大哥感谢你的大恩大德，非常符合，如果还能把其他几行也匹配上就完美了（外出务工省(市)和务工开始 时间）这2项也需要匹配