Полезные мелочи - это просто

Option Explicit
Dim XLS As Excel.Workbook
Dim XLW As Excel.Worksheet
Dim exApp As Object
Dim R As Integer
'--------------
Sub ExportTextToExcel() 'from AutoCAD
    Dim Obj As AcadEntity, DT As AcadText, MT As AcadMText
    Dim SelSet As AcadSelectionSet
    'Dim fType(1) As String: fType(0) = "AcDbText": fType(1) = "AcDbMText"
    Dim A As Long
On Error GoTo Control 'Ловим ошибку на тот случай, если пользователь нажмет "Esc"
    Set SelSet = ThisDrawing.SelectionSets.Add("Set") 'Создаем новый набор выбора, например с именем "Set"
On Error GoTo 0
    SelSet.SelectOnScreen  'Запрос на выбор примитивов
    If SelSet.Count = 0 Then GoTo Control
    Set exApp = CreateObject("Excel.Application")
    Set XLS = exApp.Workbooks.Add
    Set XLW = XLS.Worksheets.Add
    XLW.Name = "AutoCAD"
    XLW.Cells(1, 1) = "Значение"
    XLW.Cells(1, 2) = "ID Объекта"
    R = 1
    For Each Obj In SelSet
        If Obj.ObjectName = "AcDbText" Or Obj.ObjectName = "AcDbMText" Then
            A = A + 1
            If Obj.ObjectName = "AcDbText" Then
                Set DT = Obj
                AddValueInExcel Trim(DT.TextString), DT.ObjectID
            Else
                Set MT = Obj
                AddValueInExcel Trim(MT.TextString), MT.ObjectID
            End If
        End If
    Next Obj
    XLW.Range(XLW.Cells(2, 1), XLW.Cells(A, 255)).Sort Key1:=XLW.Cells(2, 1), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 'Упорядочить по значению
    XLS.Application.Visible = True 'Показать окно Excel
    PrintMessage A & " текстовых значений занесены в Excel. Введите команду ETA после корректировки значений в Excel для переноса их обратно в AutoCAD"
Control:
    SelSet.Delete 'Удаляем набор выбора
End Sub
'--------------
Private Sub AddValueInExcel(ObjValue As String, ObjID As Long)
    Dim A As Integer, B As Byte
    For A = 2 To R
        If XLW.Cells(A, 1) = ObjValue Then
            B = 2
            Do While XLW.Cells(A, B) <> ""
                B = B + 1
            Loop
            XLW.Cells(A, B) = ObjID
            Exit Sub
        End If
    Next A
    R = R + 1
    XLW.Cells(R, 1) = ObjValue
    XLW.Cells(R, 2) = ObjID
End Sub
'--------------
Sub ExportTextToAutoCAD() 'from Excel
    Dim Obj As AcadEntity, DT As AcadText, MT As AcadMText
    Dim A As Integer, B As Byte
    A = 2
    Do While XLW.Cells(A, 1) <> ""
        B = 2
        Do While XLW.Cells(A, B) <> ""
            Set Obj = ThisDrawing.ObjectIdToObject(XLW.Cells(A, B))
            If Obj.ObjectName = "AcDbText" Then
                Set DT = Obj
                DT.TextString = XLW.Cells(A, 1)
            Else
                Set MT = Obj
                MT.TextString = XLW.Cells(A, 1)
            End If
            B = B + 1
        Loop
        A = A + 1
    Loop
    PrintMessage "Задание успешно выпонено."
    If MsgBox("Закрыть приложение Excel без сохранения?", vbYesNo + vbQuestion, "Модуль AutoReX") = vbYes Then
        XLS.Close False
        Set exApp = Nothing
        Set XLS = Nothing
        Set XLW = Nothing
    End If
End Sub