Sub ConvertToChordPro_NewDocument()

    Dim srcDoc As Document
    Dim outDoc As Document
    Dim p As Long

    Set srcDoc = ActiveDocument
    Set outDoc = Documents.Add

    p = 1

    Do While p <= srcDoc.Paragraphs.count

        Dim para As Paragraph
        Set para = srcDoc.Paragraphs(p)

        ' --- CHORD LINE ---
        If para.Style = "4) Chords" Then

            ' Look ahead for lyrics
            If p < srcDoc.Paragraphs.count Then
                Dim nextPara As Paragraph
                Set nextPara = srcDoc.Paragraphs(p + 1)

                If nextPara.Style = "2) Lyrics" Then
                    Dim chordLine As String
                    Dim lyricLine As String
                    Dim mergedLine As String

                    chordLine = RTrim(Replace(para.Range.Text, vbCr, ""))
                    lyricLine = RTrim(Replace(nextPara.Range.Text, vbCr, ""))

                    mergedLine = MergeChordAndLyricLines(chordLine, lyricLine)

                    outDoc.Content.InsertAfter mergedLine & vbCrLf

                    p = p + 2
                    GoTo ContinueLoop
                End If
            End If

            ' Chord line with no lyrics ? copy as-is
            outDoc.Content.InsertAfter para.Range.Text
            p = p + 1
            GoTo ContinueLoop

        End If

        ' --- EVERYTHING ELSE ---
        outDoc.Content.InsertAfter para.Range.Text
        p = p + 1

ContinueLoop:
    Loop

    MsgBox "ChordPro document created.", vbInformation

End Sub
Function MergeChordAndLyricLines(chords As String, lyrics As String) As String

    Dim result As String
    Dim i As Long
    Dim offset As Long

    result = lyrics
    offset = 0
    i = 1

    Do While i <= Len(chords)
        If Mid(chords, i, 1) <> " " Then
            Dim chord As String
            Dim startPos As Long

            startPos = i

            chord = ""
            Do While i <= Len(chords) And Mid(chords, i, 1) <> " "
                chord = chord & Mid(chords, i, 1)
                i = i + 1
            Loop

            If startPos + offset <= Len(result) + 1 Then
                result = _
                    Left(result, startPos - 1 + offset) & _
                    "[" & chord & "]" & _
                    Mid(result, startPos + offset)
                offset = offset + Len(chord) + 2
            End If
        Else
            i = i + 1
        End If
    Loop

    MergeChordAndLyricLines = RTrim(result)

End Function