Code to cut text from 2 paragraphs below heading into the heading line

[h2whoa]

Hi all,

I genuinely thought this was going to be simple. But it turns out I'm simpler! I have a number of long documents, arranged as so, with Heading 1, 2, 3 and Normal style text:



Heading 1 - A
Heading 2 - 1
Heading 3 - 1
1 Normal text to move


1 Normal text to leave


Heading 2 - 2
Heading 3 - 2
2 Normal text to move


2 Normal text to leave

Heading 1 - B
Heading 2 - 3
Heading 3 - 3
3 Normal text to move


3 Normal text to leave
...



I'm trying to write something that will take the "normal text to move", leaving the "normal text to leave", and append it to the relevant level 2 heading. So it would look like:


Heading 1 - A
Heading 2 - 1 1 Normal text to move
Heading 3 - 1


1 Normal text to leave


Heading 2 - 2 2 Normal text to move
Heading 3 - 2


2 Normal text to leave

Heading 1 - B
Heading 2 - 3 3 Normal text to move
Heading 3 - 3


3 Normal text to leave
...



I've tried so many variations of code, but I don't really seem to be getting anywhere. The latest code I have is below. It does... something, but not what I'm aiming for. Any help gratefully received!


Sub AAMoveParagraphs()
Dim para As Paragraph

For Each para In ActiveDocument.Paragraphs
If para.sTyle = "Heading 2" Then
Selection.MoveDown Unit:=wdParagraph, Count:=2
Selection.StartOf Unit:=wdParagraph, Extend:=wdMove
Selection.Expand Unit:=wdParagraph
Selection.Range.Copy
Selection.MoveUp Unit:=wdParagraph, Count:=2
Selection.EndOf Unit:=wdParagraph, Extend:=wdMove
Selection.InsertAfter (" ")
Selection.Paste
End If
Next para
End Sub

[macropod]

So how would a macro identify the content to move and differentiate it from the content to leave as is?

[h2whoa]

So how would a macro identify the content to move and differentiate it from the content to leave as is?

Hi macropod. Thanks for your reply. The formatting of these documents always takes the same pattern. Each overall section starts with a Heading 1 style (identifying the year of the next lot of publications). Then each publication within that heading 1 group is arranged as:



Heading 2 (identifying the author)
Heading 3 (identifying title)
1 paragraph of normal text identifying the journal and date it was published
1 empty paragraph (i.e. a paragraph break acting to separate text)
1 paragraph with the abstract of the publication


So, what I was trying to get the code to do is if a paragraph is Heading 2, skip ahead two paragraphs to the journal/date text. Then select and cut that paragraph. Then go back to the previous Heading 2, add a space, then paste the cut text. After that it would continue going through paragraphs to identify Heading 2.

As the layout of the existing documents are consistent, the jumping ahead two paragraphs and selecting that paragraph should always get the text I need.

[gmayor]

Assuming that you want the text on the same line as the heading 2 line, then if your description is accurate


Sub Macro1()
'Graham Mayor - http://www.gmayor.com - Last updated - 22 Sep 2017
Dim oRng As Range
Dim oHeading As Range
Dim oPara As Paragraph
On Error GoTo lbl_Exit
For Each oPara In ActiveDocument.Paragraphs
If oPara.Style = "Heading 2" Then
Set oHeading = oPara.Range
oHeading.End = oHeading.End - 1
Set oRng = oPara.Range
With oRng
.MoveEnd wdParagraph, 2
.Start = .Paragraphs.Last.Range.Start
.End = .End - 1
End With
oHeading.InsertAfter oRng.Text
oRng.End = oRng.End + 1
oRng.Text = ""
End If
Next oPara
lbl_Exit:
Set oPara = Nothing
Set oHeading = Nothing
Set oRng = Nothing
Exit Sub
End Sub

[h2whoa]

Graham, thank you so much! I've just done a test run, and this works great! Thank you so much for your help. Can't tell you how much time this is going to save me! Greatly appreciated.