Sub 汇总()
Application.ScreenUpdating = False '关闭屏幕刷新以增加运行速度
p = "d:\test\" '假设所有要汇总的doc文件放在d:\test\文件夹,根据实际修改,注意别遗漏最后的\
f = Dir(p & "*.doc") '查找该目录下第一个doc文件
Set wd = CreateObject("word.application") '创建一个word对象
r = 1 '假设excel文件的表头是1行,如果是n行,修改这里的1
Do '开始循环
r = r + 1
Set d = wd.documents.Open(p & f) '打开第一个找到的doc文件
With d.tables(1) '假设是从word文件的第1个表中取值,如果是从第n个表取值,修改这里的1
Cells(r, 2) = Application.Clean(.cell(1, 2).Range.Text) '将word表格第1行第2列的数据存入当前工作表的B列
Cells(r, 3) = Application.Clean(.cell(1, 4).Range.Text) '将word表格第1行第4列的数据存入当前工作表的C列
Cells(r, 4) = Application.Clean(.cell(2, 4).Range.Text) '将word表格第2行第4列的数据存入当前工作表的D列
'仿照上式自行添加其他要取的值
End With
d.Close '关闭word文档
f = Dir '找下一个文档
Loop Until f = "" '如果所有文档都汇总完了,退出循环
wd.Quit '退出word
Set wd = Nothing '注销word对象
Application.ScreenUpdating = True '开启屏幕刷新
End Sub
根据自己需要修改