从Excel文档自动在Word中创build表格

我在Excel中有一组数据，如下所示（以CSV格式）

heading1, heading2, heading3, index A , randomdata1, randomdata2, 1 A , randomdata1, randomdata2, 2 A , randomdata1, randomdata2, 3 B , randomdata1, randomdata2, 4 C , randomdata1, randomdata2, 5 

我希望能够自动构build一个Word文档，将这些数据（由heading1分组的信息）显示为单独的表格。 所以Word文档就是这样的

 Table A heading1, heading2, heading3, index A , randomdata1, randomdata2, 1 A , randomdata1, randomdata2, 2 A , randomdata1, randomdata2, 3 Table B heading1, heading2, heading3, index B , randomdata1, randomdata2, 4 Table C heading1, heading2, heading3, index C , randomdata1, randomdata2, 5 

请有人可以帮助我，因为它可以节省大约20个小时的非常无聊的复制和粘贴和格式化！

谢谢你的帮助

Answer 1

大道，

希望这是及时的帮助。

为此，您需要设置对Word的引用 – 在VBA编辑器中，select“工具”>“引用”，然后向下滚动到Microsoft Word ##，其中，对于Excel '07，##为12.0，对于Excel '03为11.0等。当你运行这个表单时，不应该过滤表单，虽然你不需要按照标题1来sorting，但是我认为你已经有了。

该代码假定您的列表以单元格A1中的标题开头。 如果这不是真的，你应该这样做。 它还假设你在D中的最后一列。你可以在以“.Copy”开头的行中调整它。

 Sub CopyExcelDataToWord() Dim wsSource As Excel.Worksheet Dim cell As Excel.Range Dim collUniqueHeadings As Collection Dim lngLastRow As Long Dim i As Long Dim appWord As Word.Application Dim docWordTarget As Word.Document Set wsSource = ThisWorkbook.Worksheets(1) With wsSource lngLastRow = .Range("A" & Rows.Count).End(xlUp).Row Set collUniqueHeadings = New Collection For Each cell In .Range("A2:A" & lngLastRow) On Error Resume Next collUniqueHeadings.Add Item:=cell.Value, Key:=cell.Value On Error GoTo 0 Next cell End With Set appWord = CreateObject("Word.Application") With appWord .Visible = True Set docWordTarget = .Documents.Add .ActiveDocument.Select End With For i = 1 To collUniqueHeadings.Count With wsSource .Range("A1").AutoFilter Field:=1, Criteria1:=collUniqueHeadings(i) .Range("A1:D" & lngLastRow).Copy End With With appWord.Selection .PasteExcelTable linkedtoexcel:=False, wordformatting:=True, RTF:=False .TypeParagraph End With Next i For i = 1 To collUniqueHeadings.Count collUniqueHeadings.Remove 1 Next i Set docWordTarget = Nothing Set appWord = Nothing End Sub