Sub HeadsTransformReverse()
    Dim para As Paragraph
    Dim i As Integer
    
    For i = ActiveDocument.Paragraphs.Count - 1 To 1 Step -1
        Dim currentParaText As String
        Dim nextParaText As String
        
        currentParaText = ActiveDocument.Paragraphs(i).Range.text
        nextParaText = ActiveDocument.Paragraphs(i + 1).Range.text
        
        If Left(nextParaText, 4) = "<S5>" And Left(currentParaText, 4) = "<S4>" Then
            ActiveDocument.Paragraphs(i + 1).Range.text = "<S4-S5>" & Mid(nextParaText, 5)
            HighlightTags ActiveDocument.Paragraphs(i + 1).Range
        ElseIf Left(nextParaText, 4) = "<S4>" And Left(currentParaText, 4) = "<S3>" Then
            ActiveDocument.Paragraphs(i + 1).Range.text = "<S3-S4>" & Mid(nextParaText, 5)
            HighlightTags ActiveDocument.Paragraphs(i + 1).Range
        ElseIf Left(nextParaText, 4) = "<S3>" And Left(currentParaText, 4) = "<S2>" Then
            ActiveDocument.Paragraphs(i + 1).Range.text = "<S2-S3>" & Mid(nextParaText, 5)
            HighlightTags ActiveDocument.Paragraphs(i + 1).Range
        ElseIf Left(nextParaText, 4) = "<S2>" And Left(currentParaText, 4) = "<S1>" Then
            ActiveDocument.Paragraphs(i + 1).Range.text = "<S1-S2>" & Mid(nextParaText, 5)
            HighlightTags ActiveDocument.Paragraphs(i + 1).Range
        End If
    Next i
End Sub

Sub HighlightTags(rng As Range)
    Dim startPos As Long
    Dim endPos As Long
    Dim tagText As String
    
    startPos = InStr(rng.text, "<")
    
    While startPos > 0
        endPos = InStr(startPos, rng.text, ">")
        If endPos > 0 Then
            tagText = Mid(rng.text, startPos + 1, endPos - startPos - 1)
            rng.Start = rng.Start + startPos - 1
            rng.End = rng.Start + Len(tagText) + 2
            rng.HighlightColorIndex = wdTurquoise
            rng.Start = rng.Start + Len(tagText) + 2
        End If
        startPos = InStr(startPos + 1, rng.text, "<")
    Wend
End Sub

Sub HeadsTransformReverse()
  Dim i As Integer
  For i = ActiveDocument.Paragraphs.Count To 2 Step -1
    TagRange ActiveDocument.Paragraphs(i - 1).Range, ActiveDocument.Paragraphs(i).Range
  Next i
End Sub

Function TagRange(rng1 As Range, rng2 As Range)
  Dim i1 As Integer, i2 As Integer, rngTag As Range
  If rng1.Text Like "<S#>*" And rng2.Text Like "<S#>*" Then
    i1 = CInt(Mid(rng1.Text, 3, 1))
    i2 = CInt(Mid(rng2.Text, 3, 1))
    If i2 = i1 + 1 Then
      Set rngTag = rng2.Duplicate
      rngTag.End = rngTag.Start + 4
      rngTag.Text = "<S" & i1 & "-" & i2 & ">"
      rngTag.HighlightColorIndex = wdTurquoise
    End If
  End If
End Function