Copy content under 6 specific headings, paste it over 6 placeholder text items

The goal: for about six specifically named H1 Headings, I want to copy all the content under each heading, and paste it over specific placeholder text elsewhere in the same document.
For example, I want to copy the contents under the heading "CONTENTS", and paste it over the placeholder text "<Contents>" in the same document, and delete the original. Then move onto the next heading "ABOUT THE AUTHOR", and paste its content over the placeholder text "<About the Author>".
The reason: I have a macro that transforms a finished etext document into the makings of a braille-ready document (to be opened by Duxbury braille translation software). That macro adds a series of fixed headings and placeholder text content to the finished etext, in the order required of braille documents. Rather than manually move/consolidate the original file's headings with the braille ready version, I'd like a macro that does most/all of the work.
Progress so far: I have used Greg Maxey's macro on another thread which copies the right content, and added a bit of Find and Replace code to give a better idea of where I'm going, with notes about where I need code to run through a series of headings, rather than just the one:

Code:

---

Sub TextBetweenHeading1()
'A basic Word macro coded by Greg Maxey
'with modifications to copy content under named headings and replace specific placeholder text with it
   
    Dim docCurrent As Document
    Dim oRng As Range
    Dim oRngReplace As Range
    Set docCurrent = ActiveDocument
    Set oRng = docCurrent.Range
   
      Selection.Collapse wdCollapseEnd
     
      ' HERE I WOULD LIKE TO FIND A SERIES OF DEFINED HEADINGS, eg _
        DEDICATION, CONTENTS, COVER INFORMATION, BY THE SAME AUTHOR, ABOUT THE AUTHOR, TRANSCRIBER'S NOTE etc
        With Selection.Find
            .Style = ThisDocument.Styles("Heading 1")
            .Text = "CONTENTS^13"
            .Wrap = wdFindContinue
            If .Execute = False Then
                MsgBox "Heading not found."
                ' Move to next item if heading not found, which occasionally it may not be
            End If
        End With
       
      Selection.Collapse wdCollapseEnd
      Set oRng = Selection.Range
           
      oRng.Collapse wdCollapseEnd
      Do While oRng.Paragraphs(1).Style = "Heading 1"
       
        oRng.Move wdParagraph, 1
      Loop
      Do
        oRng.MoveEnd wdParagraph, 1
        oRng.Select
      Loop Until oRng.Paragraphs.Last.Range.Style = "Heading 1" Or oRng.Paragraphs.Last.Range.End = ActiveDocument.Range.End
      If Not oRng.End = ActiveDocument.Range.End Then oRng.MoveEnd wdParagraph, -1
      Do
        oRng.MoveStart wdParagraph, -1
        oRng.Select
      Loop Until oRng.Paragraphs(1).Range.Style = "Heading 1" Or oRng.Paragraphs(1).Range.Start = ActiveDocument.Range.Start
      If Not oRng.Start = ActiveDocument.Range.Start Or oRng.Paragraphs(1).Style = "Heading 1" Then oRng.MoveStart wdParagraph, 1
      oRng.Select
      oRng.Copy
   
    ' HERE WOULD BE A CORRESPONDING A SERIES OF PLACEHOLDER TEXT ITEMS THAT oRng WOULD REPLACE: _
      "<Cover Information>","<About this Book>","<By the Same Author>","<About the Author>","<Dedication>","<Transcriber's Note>", etc
   
    Set oRngReplace = docCurrent.Range
        With oRngReplace.Find
            .ClearFormatting
            .Text = "<Contents>"
            .Wrap = wdFindStop
            While .Execute
                oRngReplace.Text = oRng.Text
            Wend
        End With
   
    ' Delete the text at original location, tho' could also now add the original H1 heading as well
        oRng.Delete


lbl_Exit:
  Exit Sub
End Sub

---

If, instead of relying on the placeholder text, you assigned each content control a title of the same name, you could use code like:

Code:

---

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Style = wdStyleHeading1
    .Format = True
    .Forward = True
    .Wrap = wdFindStop
  End With
  Do While .Find.Execute
    If Not ActiveDocument.SelectContentControlsByTitle(Split(.Text, vbCr)(0))(1) Is Nothing Then
      Set Rng = .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
      ActiveDocument.SelectContentControlsByTitle(Split(.Text, vbCr)(0))(1).Range.FormattedText = Rng.FormattedText
      Rng.Text = vbNullString
    End If
    If .End = ActiveDocument.Range.End Then Exit Do
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub

---

Perhaps I have confused things by the phrase "placeholder text". I'm not referring to the placeholder text of a control (there are no content controls in my files), just a bit of dummy text to remind the user where to put the copied/deleted contents. It's not even in a paragraph of its own, since the files in question use text formulas like [[*<*]] and [[*p*]] which will be converted to line breaks and paragraph markers respectively when the file is opened in Duxbury Braille Translator. (It's what the original conversion macro does: headings remain as paragraphs, and all other contents are agglomerated into single paragraphs beneath them). So I'm not sure how I could use content controls.

In that case, try:

Code:

---

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrFnd As String, RngSrc As Range, RngTgt As Range
StrFnd = "DEDICATION|CONTENTS|COVER INFORMATION|BY THE SAME AUTHOR|ABOUT THE AUTHOR|TRANSCRIBER'S NOTE"
For i = 0 To UBound(Split(StrFnd, "|"))
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = Split(StrFnd, "|")(i)
      .Replacement.Text = ""
      .Style = wdStyleHeading1
      .Forward = True
      .Wrap = wdFindStop
      .Execute
    End With
    If .Find.Found = True Then
      Set RngSrc = .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
      .Collapse wdCollapseEnd
      Set RngTgt = RngSrc.Duplicate
      RngTgt.End = ActiveDocument.Range.End
      With RngTgt
        With .Find
          .Text = "<" & Split(StrFnd, "|")(i) & ">"
          .Execute
        End With
        If .Find.Found = True Then .FormattedText = RngSrc.FormattedText
        RngSrc.Text = vbNullString
      End With
    End If
  End With
Next
Application.ScreenUpdating = True
End Sub

---

That looks more along the lines that I had imagined, ie a kind of array variable.

So far, the code yields a deletion of each H1 heading and its content. But it leaves the target string untouched.

In case I haven't been explicit enough, here's the goal using a schematic example of a file's content:

CONTENTS (heading level 1)
Textual content of CONTENTS, formatted (= everything in file till next heading 1 = RngSrc)

CONTENTXS (heading level 1)
[[*fr*]]Page[[*<*]][[*rm5*]][[*p*]]<CONTENTS>[[*<*]][[*pg*]]etc (= new location showing where RngSrc should be plonked, ie replacing RngTgt = <CONTENTS> )

The result would be:

CONTENTXS
[[*fr*]]Page[[*<*]][[*rm5*]][[*p*]]Textual content of CONTENTS, formatted[[*<*]][[*pg*]]etc

... and spelling of headings would be tidied up later.

Quote:

---

Originally Posted by Walentyn

CONTENTXS (heading level 1)
[[*fr*]]Page[[*<*]][[*rm5*]][[*p*]]<CONTENTS>[[*<*]][[*pg*]]etc (= new location showing where RngSrc should be plonked, ie replacing RngTgt = <CONTENTS> )

The result would be:

CONTENTXS
[[*fr*]]Page[[*<*]][[*rm5*]][[*p*]]Textual content of CONTENTS, formatted[[*<*]][[*pg*]]etc.

---

Which is exactly what the code does. The <CONTENTS> string is replaced by all of the content associated with the corresponding Heading 1 range. Everything else is left alone.

Hi Paul,
After further testing, I got the code to work by adding the .Wrap line to find the target <dummy text>:

Code:

---

With RngTgt
        With .Find
          .Wrap = wdFindContinue
          .Text = "<" & Split(StrFnd, "|")(i) & ">"
          .Execute
        End With
        If .Find.Found = True Then .Text = RngSrc.Text
        RngSrc.Text = vbNullString
      End With

---

Ideally the RngSrc would also drop the Heading 1 heading itself. Is it easy to alter the source range by knocking off the first paragraph heading?

Cheers
Chris

Quote:

---

Originally Posted by Walentyn

I got the code to work by adding the .Wrap line to find the target <dummy text>:

---

That suggests your array items are not in the same order as the items appear in the document.

Quote:

---

Originally Posted by Walentyn

Ideally the RngSrc would also drop the Heading 1 heading itself. Is it easy to alter the source range by knocking off the first paragraph heading?

---

After:
Set RngSrc = .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
insert:
RngSrc.Paragraphs.First.Range.Text = vbNullString

This is a stunning result. The whole procedure now works exactly as intended. It was the last piece of the puzzle in a bigger procedure, so thank you very much indeed for that.

Thanks also for the explanation about the order of array items. Good to know better how that should work. As for modifying range objects, well, you make it look so simple! I suppose it is when you know how.

Thanks again.