Sub CombineLevel()    Dim ws As Worksheet    Set ws = ActiveSheet        'Просим пользователя ввести номер первой строки    Dim firstRow As Integer    firstRow = InputBox("Введите номер первой строки после заголовка таблицы", "Выбор первой строки")        'Просим пользователя ввести номер столбца из которого будем сцеплять данные    Dim colNumber As Integer    colNumber = InputBox("Введите номер столбца из которого будем сцеплять данные", "Выбор столбца для работы")        'Вставляем новый столбец левее от заданного пользователем    ws.Columns(colNumber).Insert Shift:=xlToTheLeftEnd Sub

Sub UpdateReestr()
    Dim lastRow As Long
    Call Objavlenie_perem
    lastRow = Cells(Rows.Count, NmReestry2022.Column).End(xlUp).Row ' определяем последнюю строку в столбце Reestr
    
    Dim i As Long
    For i = 1 To lastRow ' перебираем строки
        Dim valueToSum As Variant
        valueToSum = Cells(i, NmReestry2022.Column + 1).Value ' значение в добавленном столбце
        
        If Not IsEmpty(valueToSum) Then ' проверяем, что значение есть
            Dim reestrFormula As String
            reestrFormula = "=" & Cells(i, NmReestry2022.Column).Value & "+" & Cells(i, NmReestry2022.Column + 1).Value ' формируем формулу для столбца "Reestr"
            Cells(i, NmReestry2022.Column).formula = reestrFormula ' присваиваем формулу в ячейку
        End If
    Next i
End Sub

Sub ObnovlevieVR()
Set Razn = Cells.Find("Razn")
For Each c In Selection
v = Cells(c.Row, Razn.Column).Value
If c.FormulaR1C1 = "0" Then
c.FormulaR1C1 = "=" & v
Else
If Left(c.FormulaR1C1, 1) <> "=" Then
c.FormulaR1C1 = "=" & c.FormulaR1C1
End If
c.FormulaR1C1 = c.FormulaR1C1 & "+" & v
End If
c.FormulaR1C1 = Replace(c.FormulaR1C1, ",", ".")
Next
End Sub

Range7 = Empty
    For Stolb = NmNomerPP.Column To NmKBK.Column
      Set Range6 = Columns(Stolb)
      Set Range7 = Union(Range7, Range6)
      Range7.Select
    Next

Range7 = Empty
    For Stolb = NmNomerPP.Column To NmKBK.Column
      Set Range6 = Columns(Stolb)
      Set Range7 = Range7 & Range6
      Range7.Select
    Next

For Stolb = NmNomerPP.Column To NmKBK.Column
Next

For Stolb = 1 To LastStolb
          If Cells(ActiveCell.Row, Stolb).HasFormula Then
             Cells(ActiveCell.Row + 1, Stolb).FillDown
          End If
Next

For Stolb = 1 To 2, 2 To 5, 5 To 7, 7 To LastStolb
          If Cells(ActiveCell.Row, Stolb).HasFormula Then
             Cells(ActiveCell.Row + 1, Stolb).FillDown
          End If
Next

 For Stolb = 1 To name.Column
        With Cells(ActiveCell.Row + 1, Stolb)
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Interior.Color = vbWhite
        End With
        Next

 For Stolb = 1 To name.Column, 10 to 20

Option Explicit
Const FILE_NAME = "Ghbvth1.xlsx"
Const SHEET_NAME = "Ghbvth2"
Sub ClearCont()
Dim wb As Workbook
Set wb = Workbooks(FILE_NAME)
Dim sh As Worksheet
Set sh = wb.Sheets(SHEET_NAME)        
Dim LastCell As Range
        Dim Stalo As Range
        Set Stalo = sh.Cells.Find("Стало")   'Ищем ячейку Стало
            Set LastCell = sh.Cells(Rows.Count, Stalo.Column).End(xlToLeft)
            Range(Cells(Stalo.Row + 1, Stalo.Column), Cells(LastCell.Row, Stalo.Column)).Select
               Selection.ClearContents
End Sub

ActiveCell.Offset(1, 0).EntireRow.Insert