Макросом скопировать подчеркнутые красным слова

Sub HighlightAllMisspelledWords()
Dim anerror As Range
Dim str As String ' для вставки в новый документ ...
    ' Ensure screen updating is off for performance
    Application.ScreenUpdating = False
    
    ' Clear existing highlight (optional, to run the macro multiple times)
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = True
        .Highlight = True ' Find all highlighted text
        .Replacement.Highlight = False ' Remove highlight
        .Execute Replace:=wdReplaceAll
    End With
    
    ' Loop through each spelling error in the document
    For Each anerror In ActiveDocument.Range.SpellingErrors
        ' Apply a specific format (e.g., Yellow highlight) to the error range
        anerror.HighlightColorIndex = wdYellow
        anerror.Font.Bold = True ' Жирный 
        str = str & ", " & anerror.Text
    Next anerror
    
    If Len(str) > 2 Then
        str = Mid(str, 3)
        Debug.Print str
        ' Тут могет быть вставка текста в новый документ
    End If
    
    Application.ScreenUpdating = True
    MsgBox "All misspelled words have been highlighted.", vbInformation
End Sub