Sub test()
    'MsgBox Range("A1").Value
    Dim txt As String
    ActiveSheet.UsedRange.Replace "Рразд1", Range("A1").Value
End Sub

Set wa = CreateObject("Word.Application")
Set wd = wa.Documents.Open(f)
wa.Activate
msgbox wd.Shapes.Range(wd.Shapes.Count).TextFrame.TextRange.Text

Set wa = CreateObject("Word.Application")
Set wd = wa.Documents.Open(f)
wa.Activate
msgbox wd.Shapes.Range(wd.Shapes.Count).TextFrame.TextRange.Text

'
' Макрос1 Макрос
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "99887766"
        .Replacement.Text = "работает"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

    Dim fl
    fl = Application.GetOpenFilename("Файл локализации мода(*.csv*),*.csv*", 1, "Выбрать файл локализации мода", , False)
    If VarType(fl) = vbBoolean Then
        'была нажата кнопка отмены - выход из процедуры
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set fnd = ActiveSheet.Range("A2:A5722")
    'открываем книгу в новом окне
    Set ww = Application.Workbooks.Open(fl)

'ищем текст по шаблону и пишем в excel
Sub TextList()
    Dim aApp As AcadApplication 'доступ к приложению
    Dim aDoc As acaddocument 'доступ к документу
    
    Set aApp = GetObject(, "Autocad.Application")
    Set aDoc = aApp.ActiveDocument 'обращаемся к активному чертежу
    Set r = ActiveSheet.Cells.Range("A1")
    For Each entity In aDoc.ModelSpace
        If entity.ObjectName = "AcDbMText" Then 'если мультитекст
            If Left(Right(entity.TextString, Len(entity.TextString) - InStr(entity.TextString, "/")), 4) = "М4.2" And Left(entity.TextString, 2) = "Cт" Then
                r.Value = CStr(entity.TextString)
                r = r.Offset(1)
            End If
        End If
    Next
End Sub

'Список файлов на пакетную обработку
Function ScanFolder()
    Dim sFolder As String, sFiles As String
    Dim str As String
    Dim s() As String
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Function
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    sFiles = Dir(sFolder & "*.xls*")
    str = ""
    Do While sFiles <> ""
        'сохраняем полный путь  в массив строк
        If str = "" Then str = sFolder & sFiles Else str = str & "^" & sFolder & sFiles
        sFiles = Dir()
    Loop
    s = Split(str, "^")
    ScanFolder = s
End Function
Sub Замена()
    Dim fls() As String  'файлы на обработку
    Dim sFld As String 'запрашиваем адрес папки на сохранение
    Application.ScreenUpdating = False
    fls = ScanFolder()
    'sFld = GetFolder("E:\Скрипты")
For Each f In fls()
    'открываем книгу в новом окне
    Set ww = Application.Workbooks.Open(f)
    'ищем текст на земену и заменяем
    Set fnd = ww.ActiveSheet.Range("B1")
    Set zam = ww.ActiveSheet.Range("B2")
    ww.ActiveSheet.UsedRange.Replace fnd.Value, zam.Value
    Application.DisplayAlerts = False
    ww.Save
    ww.Close
    Application.DisplayAlerts = True
Next f
    Application.ScreenUpdating = True
End Sub

'Список файлов на пакетную обработку
Function ScanFolder()
    Dim sFolder As String, sFiles As String
    Dim str As String
    Dim s() As String
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Function
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    sFiles = Dir(sFolder & "*.xls*")
    str = ""
    Do While sFiles <> ""
        'сохраняем полный путь  в массив строк
        If str = "" Then str = sFolder & sFiles Else str = str & "^" & sFolder & sFiles
        sFiles = Dir()
    Loop
    s = Split(str, "^")
    ScanFolder = s
End Function

Sub test()
    Dim fls() As String  'файлы на обработку
    Dim sFld As String 'запрашиваем адрес папки на сохранение
    
    Application.ScreenUpdating = False
    fls = ScanFolder()
    'sFld = GetFolder("E:\Скрипты")
For Each f In fls()
    'открываем книгу в новом окне
    Set ww = Application.Workbooks.Add(f)
    'ищем текст на земену и заменяем
    ww.ActiveSheet.UsedRange.Replace "Мезеровский А.В.", "Шишкин С.Н."
    Application.DisplayAlerts = False
    ww.Save
    ww.Close
    Application.DisplayAlerts = True
Next f
    Application.ScreenUpdating = True
End Sub

Option Explicit

Sub Button1_Click()
Application.OnTime Now + TimeValue("00:00:05"), "DelForms(Me)"
Unload Me
End Sub
Sub DelForms(nf As Object)
ThisWorkbook.VBProject.VBComponents.Remove nf
End Sub

ub MakeForm()
    Dim TempForm As Object    'VBComponent
    Dim NewButton As Msforms.CommandButton
    Dim Line As Integer
    Dim TheForm
    Application.VBE.MainWindow.Visible = False
    ' Создание диалогового окна UserForm
    Set TempForm = ThisWorkbook.VBProject. _
                   VBComponents.Add(3)    'vbext_ct_MSForm
    With TempForm
        .Properties("Caption") = "Временная форма"
        .Properties("Width") = 200
        .Properties("Height") = 100
    End With
    ' Добавление элемента управления CommandButton
    Set NewButton = TempForm.Designer.Controls _
                    .Add("forms.CommandButton.1")
    With NewButton
        .Caption = "Щелкни!"
        .Left = 60
        .Top = 40
    End With

    With TempForm.CodeModule
        Line = .CountOfLines
        .InsertLines Line + 1, "Sub CommandButtonl_Click()"
        .InsertLines Line + 2, "MsgBox ""Привет!"""
        .InsertLines Line + 3, "Unload Me"
        .InsertLines Line + 4, "End Sub"
    End With
    ' Отображение диалогового окна UserForm
    VBA.UserForms.Add(TempForm.Name).Show
    ' Удаление диалогового окна UserForm
    ThisWorkbook.VBProject.VBComponents.Remove TempForm
End Sub

With TempForm.CodeModule
        Line = .CountOfLines
        .InsertLines Line + 1, "Sub CommandButtonl_Click()"
        .InsertLines Line + 2, "ThisWorkbook.VBProject.VBComponents.Remove TempForm"
        .InsertLines Line + 3, "End Sub"
    End With

Sub test()    
    Dim r As Range
    With ActiveSheet.ListObjects("Разделительная")
        r = .ListRows(.ListRows.Count).Range
    End With
    r.Select
End Sub

Sub test()
    With ActiveSheet.ListObjects("Разделительная")
        .Resize (.ListRows.Count + 1)
    End With
End Sub

Sub test()
    Dim r As Range
    With ActiveSheet.ListObjects("Разделительная")
        r = .ListRows(.ListRows.Count).Range
    End With
    r.Select
End Sub