求助，批量将excel的表粘贴到word里面的指定位置

妖怪横行

各位大侠，请助，如附件里面，我想把工作簿报告excel里面的工作表的一部分区域（这部分区域根据披露表的D列进行判断），粘贴到报告（空白）的指定区域去，报告（空白）的指定区域的文本跟在EXCEL里面的区域名称是保持一致的。

妖怪横行

求各位大神帮忙

妖怪横行

这是我目前写出来的代码，目前已经是复制好指定区域，但是吧这个指定区域粘贴到word的相对应的区域
后面就卡壳了。。


Sub test000()
'复制指定的区域到目标区域
Dim xhs, xhs1, name As Variant
Dim wdname As Variant
Dim myrange As Range
'打开word
    Set wo = CreateObject("Word.Application")
    Filename2 = Application.GetOpenFilename(FileFilter:="Word文件(*.docx; *.doc;*.docm),*.docx;*.docm;*.doc", Title:="选择Word报告")

    MsgBox Filename2
   
    wo.Documents.Open Filename2
    wo.Visible = True
    wdname = CreateObject("Scripting.FileSystemObject").GetBaseName(Filename2) & ".docx"
    MsgBox wdname
    '打开EXCEL附注，并取得循环数
    MsgBox ("请打开附注的Excel文件 ")
    Filename = Application.GetOpenFilename(FileFilter:="Excel文件(*.xlsx; *.xls;*.xlsm),*.xlsx;*.xlsm;*.xls", Title:="选择Excel附注")
Workbooks.Open (Filename)
    Worksheets("披露表").Select
    xhs = Range("d1000").End(xlUp).Row
    'MsgBox (xhs)
    For xhs1 = 1 To xhs
        Worksheets("披露表").Select
        If Cells(xhs1 + 2, 4).Value = "披露" Then
            name = Cells(xhs1 + 2, 5).Value
            Set myrange = Range(name)
            myrange.copy
            Documents(wdname).Select  '#####
            MsgBox (ActiveDocument.FullName)
            
           Else
        End If
    Next xhs1
End Sub

yansan

你好 你的“求助，批量将excel的表粘贴到word里面的指定位置”问题解决了吗？想向你求教

vicencl

妖怪横行 发表于 2015-12-21 14:51
这是我目前写出来的代码，目前已经是复制好指定区域，但是吧这个指定区域粘贴到word的相对应的区域
后面就 ...

还需调试修改