循环：使用书签将基于 excel 列表的段落从一个文档复制到另一个文档

Question

更多详情请参考下方截图。

Excel Sheet

源文件

在目标文档中我的代码输出下方

目标文档中的 Macropod 输出

excel 文件 Sheets("List1")，包含两列 text/string。 A 列具有段落的起始词或 table，B 列具有段落的结束词或 table。

根据A列和B列文本，宏找到源文档中的开始和结束词。如果找到，则复制所有文本或 table，包括带格式的源文档中的开始和结束字，并将其粘贴到带源格式的目标文档中的书签（Text1、Text2 等）。

我要复制的段落包含文本和 tables（在两个文本之间或末尾）

如何使用书签循环来循环 A 列和 B 列 text/string。

我在宏下面尝试的是根据源文档中的 A 列和 B 列查找文本，复制格式并将其粘贴到目标文档中的书签。

但它选择每个循环中最后一个条目的范围（文本或table）。我尝试编辑以下代码但没有成功。我没有很好的编码知识。

请看一下从 Macropod 收到的精彩答复和我的评论。

Sub CopyPasteParagraphsNew()
Dim wdApp As New Word.Application
Dim DocSrc As Word.Document, DocTgt As Word.Document, wdRng As Word.Range
Dim WS As Worksheet, r As Long
Dim i As Long
Dim j As Long

Dim M As Long
Dim N As Long


Set WS = Sheets("List1")
  Set MsWord = CreateObject("Word.Application")
  On Error Resume Next
Set wrdApp = GetObject(, "Word.Application")
On Error GoTo 0
If wrdApp Is Nothing Then
Set wrdApp = CreateObject("Word.Application")
bWeStartedWord = True
End If

With DocSrc

With MsWord
.Visible = True
.Documents.Open (ActiveWorkbook.Path & "\Source Document.doc")
.Activate

MsWord.Selection.HomeKey Unit:=wdStory
With MsWord.Selection.Find

M = Cells(Rows.Count, "A").End(xlUp).Row 'selecting last string of column A and pasting at each bookmark
For i = 1 To M
.ClearFormatting
.Wrap = wdFindStop
.MatchCase = True
.Text = Cells(i, "A").Value
.Execute
MsWord.Selection.Collapse

Next i

N = Cells(Rows.Count, "B").End(xlUp).Row 'selecting last string of column B and pasting at each bookmark
For j = 1 To N
lngStart = MsWord.Selection.End
.Text = Cells(j, "B").Value
.Execute

Next j
lngEnd = MsWord.Selection.End
MsWord.ActiveDocument.Range(lngStart, lngEnd).Copy

Set DocTgt = Documents.Open(ActiveWorkbook.Path & "\Destination Document.doc")
With DocTgt
 For t = 1 To DocTgt.Bookmarks.Count
If DocTgt.Bookmarks.Exists("Text" & t) Then

MsWord.Selection.GoTo What:=wdGoToBookmark, Name:=("Text" & t)
MsWord.Selection.PasteAndFormat wdFormatOriginalFormatting

End If
Next
End With
End With
End With
End With
End Sub

Answer 1

您的描述不清楚。也许：

Sub CopyPasteParagraphs()
Dim wdApp As New Word.Application
Dim DocSrc As Word.Document, DocTgt As Word.Document, wdRng As Word.Range
Dim WS As Worksheet, r As Long
Set WS = Sheets("List1")
With wdApp
  .Visible = True
  Set DocSrc = .Documents.Open(ActiveWorkbook.Path & "\Source Document.doc") 'SourceDocument
  Set DocTgt = Documents.Open(ActiveDocument.Path & "\Destination Document.doc")
  With DocSrc
    For r = 1 To WS.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    With .Range
      With .Find
        .Text = WS.Range("A" & r) & "*" & WS.Range("B" & r)
        .MatchWildcards = True
        .Execute
      End With
      If .Find.Found = True Then Set wdRng = .Duplicate
        With DocTgt
          If .Bookmarks.Exists("Text" & r) Then
            .Bookmarks("Text" & r).Range.FormattedText = wdRng.FormattedText
          End If
        End If
      End If
    End With
    .Close False
  End With
End With
End Sub

而不是：

      If .Bookmarks.Exists("Text" & r) Then
        .Bookmarks("Text" & r).Range.FormattedText = wdRng.FormattedText
      End If

您可能会使用：

      If .Bookmarks.Exists("Text" & r) Then
        wdRng.Copy
        .Bookmarks("Text" & r).Range.PasteAndFormat wdFormatOriginalFormatting
      End If

循环：使用书签将基于 excel 列表的段落从一个文档复制到另一个文档

Loop: Copy paragraph based on excel list from one document to another using bookmark

excel

vba

loops

ms-word

paragraph