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