将不相邻的Excel列拆分为不相邻的Word表格列

想从Excel中复制三个范围的数据，然后将这三个不同的范围粘贴到现有的Word表格中。 Word文档是从另一个程序生成的，文件名称每次都不相同。 我需要拆分三个范围，并粘贴到单词表（1），但在列不匹配的Excel副本。 当前进程是复制一个Excel范围，alt + tab到Word文档并粘贴到表中，重复剩下的两个范围。 这是我的复制代码，但我需要“粘贴”的帮助。

Sub Copy_CV() Dim MaxVal As Long, C As Long MaxVal = Worksheets("Prop").Application.Max(Columns(2)) C = MaxVal + 3 Worksheets("Prop").Range("G4:G" & C).Select Worksheets("Prop").Range("L4:L" & C).Select Worksheets("Prop").Range("M4:M" & C).Select Selection.Copy End Sub 

Answer 1

你可以做这样的事情：

 Sub Copy_CV() Dim MaxVal As Long, C As Long MaxVal = Worksheets("Prop").Application.Max(Columns(2)) C = MaxVal + 3 'open Word with COM and late binding and open document Dim Word As Object, Document As Object, Table As Object Set Word = CreateObject("Word.Application") Set Document = Word.Documents.Open("example.docx") 'get table Set Table = Document.Tables(1) 'adjust rows dif = Table.Rows.Count - MaxVal If dif > 0 Then For i = 1 To dif Table.Rows(1).Delete Next ElseIf dif < 0 Then For i = 1 To -dif Table.Rows.Add Next End If 'copy each col in excel and paste in col in the new table Worksheets("Prop").Range("G4:G" & C).Select Selection.Copy Table.Columns(1).Select 'this assumes that target rows are 1, 2 and 3 Word.Selection.PasteAndFormat 16 'wdFormatOriginalFormatting=16 Worksheets("Prop").Range("L4:L" & C).Select Selection.Copy Table.Columns(2).Select Word.Selection.PasteAndFormat 16 Worksheets("Prop").Range("M4:M" & C).Select Selection.Copy Table.Columns(3).Select Word.Selection.PasteAndFormat 16 'save and close document Document.Save Document.Close Word.Quit Set Table = Nothing Set Document = Nothing Set Word = Nothing End Sub 

这假定您想要使用文档中的第一个表格。 编辑：添加代码来修复目标表上的行数。

Answer 2

感谢您的回应！ 工作…有点儿。 这就是我遇到的问题，代码停止执行，并挂在设置文档行。 经过进一步的考虑和你展示我的可能性，我有一些额外的援助请求。 我只介绍了部分stream程，因为我只是在考虑一个方向。 实际的过程是：1）将Word表格中第5列和第6列的数据复制粘贴到Excel表格G和L中，2）调整数据并生成列M，3）复制粘贴Excel G，L和M返回Word表到第5,6和7列，然后4）因为每个字栏有独特的格式（有标签，我不能重复）我必须select每列的标题和使用格式画家格式化每列。 我试图使用macroslogging来完成这个，但没有成功，因为它只会格式化表中的第一个单元格。

单词表格 – 每次生成单独的程序但是可变的行。

请求1）访问Word文档的打开实例…如果挂起，可能有error handling程序2）从Word表格1列5和6复制数据并粘贴到Excel表格列G＆L 3）复制数据从Excel表格列G，L＆M中粘贴到Word表格1，第5,6和7列中。4）基于表格格式的第5,6和7列格式化每列的2个单元格。

字表1

Sub Copy_CV（）Dim MaxVal As Long，C As Long

  MaxVal = Worksheets("Prop").Application.Max(Columns(2)) C = MaxVal + 3 'open Word with COM and late binding and open document Dim Word As Object, Document As Object, Table As Object Set Word = CreateObject("Word.Application") Set Document = Word.Documents.Open("c:\test\Test.rtf") 'get table Set Table = Document.Tables(1) ' Worksheets("Prop").Range("G4:G" & C).Select Selection.Copy Table.Cell(Row:=3, Column:=5).Range.Select Word.Selection.Collapse Word.Selection.PasteAndFormat (wdTableOverwriteCells) 'Copy ppa Worksheets("Prop").Range("L4:L" & C).Select Selection.Copy Table.Cell(Row:=3, Column:=6).Range.Select Word.Selection.Collapse Word.Selection.PasteAndFormat (wdTableOverwriteCells) 'Copy klbs Worksheets("Prop").Range("M4:M" & C).Select Selection.Copy Table.Cell(Row:=3, Column:=7).Range.Select Word.Selection.Collapse Word.Selection.PasteAndFormat (wdTableOverwriteCells) 'save and close document Document.Save Document.Close Word.Quit Set Table = Nothing Set Document = Nothing Set Word = Nothing End Sub