Private Sub Workbook_Open()
    ActiveSheet.Paste
    Selection.ColumnWidth = 7
    Columns("C:C").Cut
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:B").Select
    Selection.Cut
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight
    Rows("2:2").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$E$10000").AutoFilter Field:=5, Criteria1:="<>"
    ' Макрос выделения с адресами до последней заполненной ячейки
    Range("A1", Cells(Rows.Count, 7).End(xlUp)).Select
Selection.Copy
Sheets("Лист3").Select
ActiveSheet.Paste
    Rows("2:2").Select
'фильтр по цвету
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Лист3").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист3").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "C2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Лист3").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A3", Cells(Rows.Count, 7).End(xlUp)).Select
    Selection.Copy
    Sheets("sheet1").Select
    ActiveSheet.Paste
    Rows("3:3").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("sheet1").AutoFilter.Sort.SortFields.Clear
'сортировака по возрастанию
    ActiveWorkbook.Worksheets("sheet1").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "A5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'Selection.Delete Shift:=xlUp
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
'Шаг 3: Выбираем следующую строку вниз
Cells(LastRow, 2).Offset(1, 0).Select
'пишим нужный текст
'ActiveCell.FormulaR1C1 = "Не набивные и шкуры"
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(LastRow, 5).Offset(1, 0).Select
'ActiveCell.FormulaR1C1 = "0"
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(LastRow, 1).Offset(2, 0).Select

    
    'проблемный участов вставки 1.
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "=RC[-3]*RC[-1]"
    Range("i4:i" & Cells(Rows.Count, 1).End(xlDown).Row).Formula = [i4].FormulaR1C1
    Range("B4", Cells(Rows.Count, 9).End(xlUp)).Select
    Range("R4").Select
    ActiveCell.FormulaR1C1 = "=R[1]C[-13]"
    Range("R4").Select
    ActiveCell.FormulaR1C1 = "=R[-2]C[-13]"
    Range("O4:P4").Select
    Sheets("Лист3").Select
    Range("E1").Select
    Selection.Copy
    Sheets("sheet1").Select
    Range("O4:P4").Select
    ActiveSheet.Paste
    Range("O5:P5").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C"
    Range("O6").Select
    Range("U5:V5").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C[-6]"
    Range("U6").Select
    Range("X4").Select
    ActiveCell.FormulaR1C1 = "=RC[-6]"
    Range("X5").Select
    Range("R5").Select
    ActiveCell.FormulaR1C1 = "=MID(R[-1]C[-3],1,FIND(""-"",R[-1]C[-3])-1)"
    Range("R6").Select
    
    Application.DisplayAlerts = False
    Sheets("Лист2").Delete
    Application.DisplayAlerts = True

    Application.DisplayAlerts = False
    Sheets("Лист3").Delete
    Application.DisplayAlerts = True
    
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Dingdan-1\" & [O4] & Re & ".xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    
End Sub

    Sheets("sheet1").Select
    
    LastRow = Cells(Rows.Count, 4).End(xlUp).Row
    'Шаг 3: Выбираем следующую строку вниз
    Cells(LastRow, 9).Offset(1, 0).Select
    Range(Selection, Selection.End(xlDown)).Delete