Copy text from multiple headings

[SJohan]

Hi, i need something but is difficult for me. So i need to copy the text of heading 9 inside [] at the end of the paragraph of heading 7. Is this difficult to do?

[macropod]

Hi SJohan,

Try:
Sub InsertRefs()
Application.ScreenUpdating = False
Dim RngHdA As Range, RngHdB As Range, RngRef As Range
Dim iRefHd As Long, StrTxt As String, oPara As Paragraph
' Word's inbuilt heading styles are indexed as -2 to -10, so negate the Heading Style # and subtract 1
iRefHd = -8
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Style = iRefHd
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
Set RngHdA = .Paragraphs(1).Range.Duplicate
With RngHdA
On Error GoTo ParaLast
While ActiveDocument.Styles(.Paragraphs.Last.Next.Style).BuiltIn = False Or _
.Paragraphs.Last.Next.Style > ActiveDocument.Styles(iRefHd) Or _
.Paragraphs.Last.Next.Style < ActiveDocument.Styles(iRefHd + 1)
.MoveEnd wdParagraph, 1
Wend
ParaLast:
StrTxt = ""
If .Paragraphs.Count > 1 Then
Set RngRef = RngHdA.Paragraphs(1).Range.Characters.Last
.MoveStart wdParagraph, 1
Set RngHdB = RngHdA
With RngRef
.MoveEnd wdCharacter, -1
For Each oPara In RngHdB.Paragraphs
If ActiveDocument.Styles(oPara.Style).BuiltIn = True Then
If oPara.Style = ActiveDocument.Styles(-11) Then
If Len(Trim(oPara.Range.Text)) > 1 Then
StrTxt = StrTxt & Left(oPara.Range.Text, Len(oPara.Range.Text) - 1) & ", "
End If
End If
End If
Next
If Len(StrTxt) > 0 Then
StrTxt = "[" & Left(StrTxt, Len(StrTxt) - 2) & "]"
.InsertAfter StrTxt
End If
End With
End If
End With
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub

[SJohan]

Yep.

[SJohan]

Yep.
Thanks, for your help. Not only thanks, but excited for the speed of solving this.