Private Sub TextBox1_Change()
Sheets("БДП").Range("G2").Value = TextBox1.Value
End Sub

Private Sub Workbook_Open()
    [I4] = [I4] + 1
    Me.Save
End Sub

Private Sub Workbook_Open()
On Error Resume Next
    With Workbooks("новый").Worksheets("номер")
        .Cells(4, 9).Value = .Cells(4, 9).Value + 1
    End With
    
    Cells(4, 4).Value = Cells(4, 4).Value + 1
    Me.Save
End Sub

Private Sub Workbook_Open()
On Error Resume Next
    With Workbooks("новый").Worksheets("учетный лист")
            .Cells(4, 9).Value = .Cells(4, 9).Value + 1
    End With
    Me.Save
End Sub

Cells(4, 4).Value = Cells(4, 4).Value + 1

.Cells(4, 9).Value = .Cells(4, 9).Value + 1

Private Sub Workbook_Open()
On Error Resume Next
    With Workbooks("новый").Worksheets("учетный лист")
            .Cells(4, 9).Value = .Cells(4, 9).Value + 1
    End With
    Me.Save
End Sub

Sub сохранение_новый()
t = Application.ThisWorkbook.Path
t = StrReverse(Mid(StrReverse(t), InStr(1, StrReverse(t), "\") + 1))
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=t & "\папки\" & CStr(Range("A4")) & "\" & CStr(Range("B4")) & "\" & Range("AC3") & ".xlsb"
Selection.Replace What:="[*]", Replacement:=""
ActiveSheet.Buttons.Delete
Application.DisplayAlerts = True
End Sub

Sub сохранение_новый()
t = Application.ThisWorkbook.Path
t = StrReverse(Mid(StrReverse(t), InStr(1, StrReverse(t), "\") + 1))
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=t & "\папки\" & CStr(Range("A4")) & "\" & CStr(Range("B4")) & "\" & Range("AC3") & ".xlsb"
Selection.Replace What:="[*]", Replacement:=""
ActiveSheet.Buttons.Delete
Application.DisplayAlerts = True
End Sub

Sub очистка()
Dim TBL As ListObject
Set TBL = ActiveSheet.ListObjects("ремонты")
ActiveSheet.ListObjects("ремонты").ListColumns(1).DataBodyRange.Select
  If TBL.ListRows.Count > 1 Then
  TBL.DataBodyRange.Delete
  End If
End Sub

Sub удаление_в_архив2()
'
'

 Application.ScreenUpdating = False
 Set ws = ActiveSheet
    ActiveSheet.Range("$A$1:$J$10000").AutoFilter Field:=10, Criteria1:="0,00"
     Set mr = ws.AutoFilter.Range.Offset(1, 1). _
        Resize(ws.AutoFilter.Range.Rows.Count - 1, ws.AutoFilter.Range.Columns.Count)
    mr.SpecialCells(xlCellTypeVisible).EntireRow.Select
    Selection.Copy
    Sheets("архив").Select
    Range("A2").Select
    ActiveSheet.Paste
    Range("A2:J100000").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("архив").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("архив").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("архив").Sort
        .SetRange Range("A2:J100000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Save
    Sheets("прайс").Select
    mr.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    ActiveSheet.Range("$A$1:$J$10000").AutoFilter Field:=10
    Application.ScreenUpdating = True
End Sub

Sub удаление_в_архив()
'
'

'Application.ScreenUpdating = False
    ActiveSheet.Range("$A$1:$J$10000").AutoFilter Field:=10, Criteria1:="0,00"
    Range("A9:J9").Select
    Selection.Copy
    Sheets("архив").Select
    Range("A2").Select
    ActiveSheet.Paste
    Range("A2:J100000").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("архив").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("архив").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("архив").Sort
        .SetRange Range("A2:J100000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Save
    Sheets("прайс").Select
    Range("A9:J9").Select
    Selection.ClearContents
     Selection.EntireRow.Delete
    ActiveSheet.Range("$A$1:$J$10000").AutoFilter Field:=10
    Application.ScreenUpdating = True
End Sub