前两个系列分别介绍了如何在Excel中利用VBA技术访问Word文档，并读取/写入内容，感兴趣的小伙伴可自行查看~

需求

今天我们来说个写入Word中的一个实用小技巧，如何批量将Excel中的数据分类写入Word中？

什么意思呢？现在我们在Excel中有如下一份数据源：

如何将之按部门拆分，并分别存储到4个Word文件中去呢，结果如下图所示：

之前有介绍过如果拆分Excel工作簿，并储存到不同工作表或工作簿中去，这里逻辑是一致的，只不过访问Word程序VB代码做些许改变即可！

解决方案

话不多说，我们直接上代码，打开Visual Basic视图，输入以下代码：

浅绿色字体为注释部分，删除不影响代码正常运行，这里标注上，便于大家理解！

代码思路讲解

第一个for 循环1到4次，主要是要拆分的数据源中，我们已经知道是4个部门了，所以只要循环四次即可，对应倒数第三行的next；

j的作用主要是统计一个部门一共有多少行数据，然后在对应的Word中好插入对应行数的表格；

接着就是新建一个Word文档，然后在此Word中新建一个表格，循环Excel数据源，将属于此部门（i部门）的数据循环写入Word中，保存并命名；

循环下一个部门，依次完成四个部门的数据拆分！

便于小伙伴们复制，完整代码展示如下：

Sub 拆分数据()
For i = 1 To 4
j = WorksheetFunction.CountIf([a:a], i & "部门")
Dim wdapp As Word.Application
Set wdapp = New Word.Application
With wdapp
.Documents.Add
.Visible = True
.Documents(1).Tables.Add .Selection.Range, j, 5
.Documents(1).Tables(1).Style = "网格型"
For Each Rng In [a2:a18]
If Rng.Value = i & "部门" Then
arr = Rng.EntireRow.Range("a1:e1")
For Each ar In arr
n = n + 1
.Documents(1).Tables(1).Range.Cells(n).Range = ar
Next
End If
Next
n = 0
.Documents(1).SaveAs ThisWorkbook.Path & "\拆分文档\" & i & "部门.docx"
.Quit
End With
Next
MsgBox "已完成"
End Sub

小结

好啦，以上就是关于如果利用VBA技术拆分Excel表格， 并保存到Word中去，有问题的小伙伴，欢迎留言讨论。

如果觉得有用，欢迎关注我，定期分享数据小技巧！