将非相邻Excel列中的副本拆分为不相邻的Word表列

时间:2016-01-21 19:07:00

标签: excel vba excel-vba ms-word word-vba

想要从Excel复制三个数据范围,然后将三个不同的范围粘贴到现有的Word表中。 Word文档是从另一个程序生成的,每次文件名都不同。我需要将三个范围拆分并粘贴到单词表(1)中,但是粘贴到与Excel副本不匹配的列中。当前进程是将一个Excel范围复制,将alt +选项卡复制到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

2 个答案:

答案 0 :(得分: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

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

答案 1 :(得分:0)

感谢您的回复!工作...有点儿。这是我遇到的,代码停止执行并挂起在Set Document行。在进一步考虑并向您展示可能性后,我还有一些额外的帮助请求。我只提出了部分过程,因为我只想到一个方向。实际过程是1)我将Word表格的第5列和第6列的数据复制粘贴到Excel表格G和L,2)我调整数据并生成列M然后3)我复制并粘贴Excel G,L和M回到Word表格到第5,6和7列然后4)因为每个Word列都有唯一的格式(包含我无法复制的标签)我必须为每列选择标题并使用格式画家格式化每列。我尝试使用宏录制来完成此操作,但没有成功,因为它只会格式化表格中的第一个单元格。

单词表 - 从单独的程序生成,但每次都是可变行。

请求 1)访问word文档的打开实例...如果它挂起可能有一个错误处理程序 2)从Word表1第5列和第5列复制数据。 6并粘贴在Excel表格栏G&amp;大号 3)从Excel表格列G,L和L中复制数据。 M并粘贴到Word表1第5列,第6列和第5列中。 7。 4)格式化Word表格列5,6和6。图7基于每列的表格行2格式的格式。

Word Table 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