Excel VBA复制将每个命名范围粘贴到单词 [英] Excel VBA copy pasting each named range to word

问题描述

我有动态命名的单元格范围.我需要将每个命名范围粘贴到单词的一页中，然后移至下一个命名范围的下一页.我尝试了copule代码，但我做不到，每个命名范围数据都相互重叠.谁能帮我.

I have dynamic named range of cell. I need to paste each named range in one page of word and move to next page for next named range. I tried copule of code, I am unable to do.Each named range data is overlapping each other. Can anyone help me, please.

Set wbBook = ActiveWorkbook
Set rs = wbBook.Names(1).RefersToRange

For i = 2 To wbBook.Names.Count
    Set rs = Union(rs, wbBook.Names(i).RefersToRange)
Next

rs.Copy

With wd.Range
    .Collapse Direction:=0
    .InsertParagraphAfter
    .Collapse Direction:=0
    .PasteSpecial False, False, True
    Application.CutCopyMode = False
End With

推荐答案

听起来您想将每个范围复制到不同的页面上，所以我不确定为什么要使用联合.这是将每个命名范围名称"复制到Word文档中新表上的快速示例.注意:为简单起见，我创建了一个新文档.

It sounds like you want to copy each range onto different pages so I'm not sure why you're using a union. Here is a quick example of copying each named range 'name' onto a new sheet in a word document. Note: I created a new doc for simplicity.

编辑-我在最后添加了数据复制/粘贴功能.格式化等取决于您拥有或想要的东西.

Edit - I added copy/paste functionality of data to the end. Formatting and such depends on what you have or want.

Sub main()
    'Create new word document
    Dim objWord As Object
    Dim objDoc As Object
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    Set objDoc = objWord.documents.Add()

    Dim intCounter As Integer
    Dim rtarget As Word.Range
    Dim wbBook As Workbook
    Set wbBook = ActiveWorkbook

    'Loop Through names
    For intCounter = 1 To wbBook.Names.Count
       Debug.Print wbBook.Names(intCounter)

       With objDoc
            Set rtarget = .Range(.Content.End - 1, .Content.End - 1)

            'Insert page break if not first page
            If intCounter > 1 Then rtarget.insertbreak Type:=wdPageBreak

            'Write name to new page of word document
            rtarget.Text = wbBook.Names(intCounter).Name & vbCr

            'Copy data from named range
            Range(wbBook.Names(intCounter)).Copy
            Set rtarget = .Range(.Content.End - 1, .Content.End - 1)
            rtarget.Paste
       End With
    Next intCounter
End Sub

Excel

生成的Word文档

这篇关于Excel VBA复制将每个命名范围粘贴到单词的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！