Good day,

I need to replace the paragraph marks with line break symbols in all the POETRY lines except the last one in each poetry extract with style “quote poet”.
When there is one line only there should be no change.

Here is a sample text, RS Vol 1 B1 (2022 04 09) – import 3d.docx linked https://drive.proton.me/urls/YHMZ9BCNGM#jt39eAAjcpgq

I have created a Word macro to do it but it does not work well.

Can someone help ?

Here is the code:

Sub ParaBreakToLineBreak()
‘
‘ ParaBreakToLineBreak Macro
‘ ParaBreakToLineBreak Style = “quote poet” Selection.MoveLeft Unit:=wdCharacter, Count:=1
‘

' Go to start of document
Selection.HomeKey Unit:=wdStory

Do

For Each Paragraph In ActiveDocument.Paragraphs

Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("quote poet")
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "^$"
End With
Selection.Find.Execute

If Paragraph.Next.Style = "quote poet" Then
            
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine

Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("quote poet")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("quote poet")
With Selection.Find
    .Text = "^p"
    .Replacement.Text = "^l"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
End With
  
Selection.Find.Execute
With Selection
    If .Find.Forward = True Then
        .Collapse Direction:=wdCollapseStart
    Else
        .Collapse Direction:=wdCollapseEnd
    End If
    .Find.Execute Replace:=wdReplaceOne
    If .Find.Forward = True Then
        .Collapse Direction:=wdCollapseEnd
    Else
        .Collapse Direction:=wdCollapseStart
    End If
    .Find.Execute
End With

Else
Selection.MoveDown Unit:=wdLine, Count:=1

‘ Paragraph.Next.Style = “Body Text First Indent1”

End If

Next

Selection.MoveDown Unit:=wdLine, Count:=1
    
Loop Until Selection.Range.End = ActiveDocument.Range.End

End Sub