Sub TestBookmarks1()
    Dim newDoc As Document
    Dim openDoc As Document
    Dim aRng As Range
    Dim newName As String
    ' Dim oldName As String
    Dim bookmarkRange As Range

    Set openDoc = ActiveDocument
    
    Set aRng = Selection.Range
    
    Set newDoc = Documents.Add
    newDoc.Content.Paste

    For Each bookmark In newDoc.Bookmarks
        ' Check if the bookmark name starts with "_Ref" (assuming this pattern)
        If Left(bookmark.Name, 4) = "_Ref" Then
            ' Generate new name
            newName = "New_" & Mid(bookmark.Name, 5)
            ' Rename the bookmark - this causes an error, as Name is read-only
            ' bookmark.Name = newName
            ' Save bookmark range
            Set bookmarkRange = bookmark.Range
            ' An attempt to use bookmark.Delete where it is, but this did not work - not sure why
            ' Set oldName = bookmark.Name
            ' Delete the old bookmark - if this is here, the update does not work, as bookmark.Name is deleted
            ' bookmark.Delete
            ' Add a new bookmark with the updated name
            newDoc.Bookmarks.Add newName, bookmarkRange
            ' Update the cross-references to point to the new bookmark name
            ' UpdateCrossReferences openDoc, bookmark.Name, newName
            UpdateCrossReferences newDoc, bookmark.Name, newName
            ' UpdateCrossReferences newDoc, oldName, newName
            ' Delete the old bookmark with the _Ref name
            bookmark.Delete
        End If
    Next bookmark

    ' Copy the modified content back to the original document
    aRng.FormattedText = newDoc.Range.FormattedText
    ' Close the temporary document without saving changes
    newDoc.Close SaveChanges:=wdDoNotSaveChanges
End Sub

Sub UpdateCrossReferences(doc As Document, oldName As String, newName As String)
    Dim fld As field
    Dim rng As Range

    For Each fld In doc.Fields
        If fld.Type = wdFieldRef Then
            Set rng = fld.Code
            Do While InStr(rng.Text, oldName) > 0
                rng.Text = Replace(rng.Text, oldName, newName)
            Loop
        End If
    Next fld
End Sub