Dim iA As Long, iB As Long
    iA = Columns("A").Find("(", [A1], LookIn:=xlValues, SearchDirection:=xlNext).Row
    iB = Columns("A").Find(")", [A1], LookIn:=xlValues, SearchDirection:=xlNext).Row
Range(Cells(iA, 1), Cells(iB, 1)).Select

Option Explicit
Public endRow As Integer

Sub Сортировка_строки()

endRow = Sheets("исходник").Cells(Rows.Count, 1).End(xlUp).Row

' cортировка одной строки
    ActiveWorkbook.Worksheets("исходник").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("исходник").Sort.SortFields.Add2 Key:=Range("B2:R2" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("исходник").Sort
        .SetRange Range("B2:R2")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 Sub SaveAsO()
    Const strRootFolder As String = "E:\Работа\2019\"
    Dim zName As String, zAdress As String, vFile As String
    zName = Replace_symbols(ActiveWorkbook.Sheets("dannye").Range("b3").Value)  'имя папки
    zAdress = Replace_symbols(ActiveWorkbook.Sheets("dannye").Range("b4").Value)  'имя файла (адрес)
    ' если папка есть, то пропуск, если нет, то создаем 
    If Dir(strRootFolder & zName, vbDirectory) = "" Then
        MkDir strRootFolder & zName
    End If
   
    vFile = strRootFolder & zName & "\" & zAdress & ".xlsb" 'имя и путь файла
    ' сохраняем
   ' On Error Resume Next
    ActiveWorkbook.SaveAs FileName:=vFile, FileFormat:=xlExcel12
End Sub

Sub ForTran() 'перевод формул РУС-ENG
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .SetText ActiveCell.Formula: .PutInClipboard: End With
'MsgBox ActiveCell.Formula & vbCrLf & _
'"" & "Перевод помещён в буфер обмена", , "Formula Translate"
End Sub

Sub NewBook()
 On Error Resume Next
Workbooks.Add
        Лист01.Copy before:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Лист02.Copy before:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        Лист03.Copy before:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)

End Sub

Sub NewBook2()
 On Error Resume Next
'Workbooks.Add
Workbooks("книга18").Activate
        Лист01.Copy before:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
Workbooks("книга18").Activate
        Лист02.Copy before:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
Workbooks("книга18").Activate        
        Лист03.Copy before:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
End Sub

Sub Copy_to_2()
        Лист1.Range("$J3:$K3").AutoFilter Field:=1, Criteria1:="<>"
        Лист1.Range("J3:K" & Cells(Rows.Count, 1).End(xlUp).Row).Copy Cells(Rows.Count, 7).End(xlUp).Offset(2)
        Лист1.Range("$J3:$K3").AutoFilter Field:=1
End Sub

Sub d()
    With Лист2.Range("A1:D1")
        .Formula = Array("=Проверка!A1 + Проверка!E1") 'с листа Проверка 
        .Value = .Value
    End With
End Sub

Sub d2()
    With Лист2.Range("A1:D1")
dim z as variant
z = "Проверка!"
        .Formula = Array("=z & A1 + z & !E1") 'с листа Проверка 
        .Value = .Value
    End With
End Sub

' удаление строк по значению
Sub УдалениеСтрок()
Application.ScreenUpdating = False
Dim ra As Range, delra As Range, itxt As String
itxt = "край"
With ActiveSheet
    For Each ra In .Range("B4:B" & 13)
        If Not ra.Find(itxt, , xlValues, xlPart) Is Nothing Then
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
End With
If Not delra Is Nothing Then delra.EntireRow.Delete
 Application.ScreenUpdating = True
End Sub

Option Explicit

Sub формулы()
Application.ScreenUpdating = False
Лист1.Select

Dim iQ As Integer
iQ = 1000

'объявление переменной
Dim TextFormula As String
Dim TextFormula3 As String
Dim TextFormula4 As String
Dim TextFormula5 As String
'Dim TextFormula6 As String
'Dim TextFormula7 As String
'Dim TextFormula8 As String
'Dim TextFormula9 As String

'формулы
TextFormula = "=1+2"
TextFormula3 = "=B5+3"
TextFormula4 = "=C5+2"
TextFormula5 = "=D5+6"
'TextFormula6 = ""
'TextFormula7 = ""
'TextFormula8 = ""
'TextFormula9 = ""

'запись формул в первую используемую строку
Range("b5").Formula = TextFormula
Range("C5").Formula = TextFormula3
Range("D5").Formula = TextFormula4
Range("E5").Formula = TextFormula5
 
'заполнение результатов формул в виде текста в последующие строки
Range("b5:b" & iQ).FillDown
Range("b5:b" & iQ).Value = Range("b5:b" & iQ).Value
 
 
Range("C5:C" & iQ).FillDown
Range("C5:C" & iQ).Value = Range("C5:C" & iQ).Value
 
Range("D5:D" & iQ).FillDown
Range("D5:D" & iQ).Value = Range("D5:D" & iQ).Value

Range("E5:E" & iQ).FillDown
Range("E5:E" & iQ).Value = Range("E5:E" & iQ).Value
 
Application.ScreenUpdating = True
End Sub

Sub Город()

    ActiveCell.FormulaR1C1 = "Город"
    ActiveCell.Offset(1, 0).Select
    
End Sub