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

'
' Макрос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

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 str As String
    str = ActiveSheet.ListObjects("Разделительная").Range.Address
    Range(str).Cells(Range(str).Rows.Count, 1).End(xlUp).Row.Select
End Sub

Sub УдалПеренос()
    Dim r As Range
    Dim str As String
    For Each r In Selection
        str = r.Value
        If (InStr(str, Chr(10)) <> 0) Then
            str = Left(str, InStr(str, Chr(10)) - 1)
            r.Value = str
        End If
    Next r
End Sub

MsgBox (Application.ThisWorkbook.Names("Бетон").RefersToRange.Cells(1, 1).Value)

Sub DopDocuments()  'автосоздание доп.документов по шаблону
    Dim r As Range 'для чтения списка доп документов
    Dim n As name   'для чтения аргументов доп документа
    Set we = ThisWorkbook 'запомнили книгу с данными и скриптом
    Application.DisplayAlerts = False  'вроде как отключает уведомления
    For Each r In Intersect(Range("ДопДокументы"), Range("ДопДокументы_Документ")) 'перебираем доп.документы
        Set ww = Application.Workbooks.Add("D:\Системные файлы\Документы\Настраиваемые шаблоны Office\" & r.Value & ".xltx") 'создали новую книгу
        For Each n In ww.Names 'перебираем имена внутри доп.документа
            MsgBox (Intersect(we.Parent.Range("ДопДокументы"), we.Parent.Range("ДопДокументы_Документ")).Cells(1).Value)
        Next n
    Next r
End Sub

Sub Act()
    Dim r As Range
    Dim t As String
    Dim j As Integer   'счетчик числа актов для нумерации
    Dim fold As String  'хранит адрес каталога, куда сохранятся акты
    j = 0
    Set wa = CreateObject("Word.Application")
    wa.Visible = True
    wa.DefaultSaveFormat = "" 'по-умолчанию сохраняет в старый формат word. Затестить в docx.
    'wd = NewDoc("Акт")
    fold = GetFolder("D:\Работа\")
    For Each r In Intersect(Range("динам"), Range("Акт")) 'в столбце Акты число строк равно числу актов
    Set wd = wa.Documents.Add("D:\Системные файлы\Документы\Пользовательские шаблоны Office\Акт2.dotx", True) 'создаем новый документ для каждого акта
    For Each i In wd.bookmarks              'перебор всех закладок для каждого акта
        If Left(i.name, 3) = "dnm" Then
            t = Intersect(Range("динам"), Range(Replace(i.name, "dnm", ""))).Cells(r.Row - 1).Value 'если динамическая - данные из таблицы
            If (i.name = "dnmЧисло") Or (i.name = "dnmЧисло1") Or (i.name = "dnmЧисло2") Then t = Format(t, "«  dd  »  mmmm  yyyy г.") 'обработка дат по формату. может, добавить префикс для автообработки дат?
            i.Range.Text = t
        End If
        If Left(i.name, 3) = "scr" Then
            t = ProcessDol(i.name, Range("Число").Cells(r.Row - 1).Value)
            i.Range.Text = t
        End If
        If (Left(i.name, 3) <> "dnm") And (Left(i.name, 3) <> "scr") Then
            i.Range.Text = Range(i.name).Value  'иначе - юзаем статику
        End If
    Next i
    j = j + 1
    wd.SaveAs (fold & "Акт" & j & ".doc") 'сохраняем документ с именем типа Акт1.docx. Позднее научить сохранять с названием работ.
    wd.Close                                 'просто закрыли документ. после удачного испытания убрать эту строку.
    Next r
End Sub

Function NewForm(name As String) As Object
    Dim myForm As Object
    'Application.VBE.MainWindow.Visible = False
    Set myForm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
    myForm.Properties("Caption") = name
    myForm.Properties("Width") = 300
    myForm.Properties("height") = 270
    VBA.UserForms.Add(myForm.name).Show
    Set CreateForm = myForm
End Function
Sub DelForm(name As Object)
    ThisWorkbook.VBProject.VBComponents.Remove name
End Sub
Sub Start()
    Dim my As UserForm
    Set my = NewForm("MyFormCaption")
    'Call DelForm(my)
    ThisWorkbook.VBProject.VBComponents.Remove my
End Sub

Function tmp(act As Variant) As Variant
    Dim tmp1, tmp2
    Dim a, b, i As Integer
    a = -2
    b = 2
    Randomize
    Dim cl As Range
    Set cl = Application.Caller
    If Left(cl.Value, InStr(cl.Value, "/")) <> act Then
label:
    i = Int((b - a + 1) * Rnd + a)
    If i = 0 Then GoTo label
    tmp1 = Replace(Application.WorksheetFunction.Text(act, "0.00"), ".", ",")
    tmp2 = Replace(Application.WorksheetFunction.Text(act + i / 100, "0.00"), ".", ",")
    tmp = tmp1 & "/" & tmp2
    End If
End Function

Function fnd(st As Variant) As Variant
    Dim str, stlb As Integer
    str = Worksheets(1).Range("A1:A40").Find(ActiveSheet.Cells(ActiveCell.Row, 1).Value).Row
    stlb = Worksheets(1).Range("A1:P1").Find(st).Column
    fnd = Worksheets(1).Cells(str, stlb).Value
End Function