Sub file_export()
Set wb_kong = ActiveWorkbook
wb_kong_name = ActiveWorkbook.Name
Set ws_kong_sheet1 = wb_kong.Sheets("sheet1")
        Worksheets("worksheet").Activate
        For i = 4 To 3000
            If Cells(i, 1) = "" Then Exit For
            Cells(i, 10) = ws_kong_sheet1.Cells(i, 6)
            Cells(i, 11) = "=G" & i & "-J" & i
        Next i
ActiveWorkbook.Save
    Dim wb As Workbook
    Set wb = Workbooks.Add
    ThisWorkbook.Sheets("worksheet").Copy Before:=wb.Sheets(1)
    filename = Mid(wb_kong_name, 4, Len(wb_kong_name) - 10)
    wb.SaveAs ("..\..\orders\repl-orders\offc-" & filename & ".xlsx")
    ActiveWorkbook.SendMail Array("aybek.k.j@gmail.com"), filename
wb_kong.Close (0)
End Sub

ActiveWorkbook.SendMail Array("mail1@excel-vba.ru", "mail2@excel-vba.ru"), "Тема письма"

=IFS(F2="YandexMarket","https://yandex.ru/maps/-/CCUufZQApC", F2="OZON","https://yandex.ru/maps/-/CCUubUFShD", F2="AliExpress","https://yandex.ru/maps/-/CCUurWB6DA", F2="Wildberries","Еще не задана точка")

Selection.Replace What:=" СТС", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Sub Кнопка1_Щелчок()
'open file dialog window
ChDir ThisWorkbook.Path & "\"
impfilename = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", 2, "Выбрать текстовые или Excel файлы", , False)
If impfilename = "False" Then Exit Sub

wb_base_name = ActiveWorkbook.Name
ws_base_name = ActiveWorkbook.ActiveSheet.Name
  
Set wb = Application.Workbooks.Open(impfilename)

    'Копируем по одному колонки C, F, K
    Columns("C:C").Copy
    Sheets.Add.Name = "worktop"
    ActiveSheet.Paste
    Sheets("Sheet1").Columns("F:F").Copy
    Sheets("worktop").Columns("B:B").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Columns("K:K").Copy
    Sheets("worktop").Columns("C:C").Select
    ActiveSheet.Paste
    
    'Добавляем колонку и ставим формулу который укорачивает Артикул
    Columns("B:B").Insert
    Range("A2", Cells(Rows.Count, "A").End(xlUp)).Offset(, 1).FormulaR1C1 = "=""A""&RIGHT(RC[-1],5)"
    Range("A2:D" & Cells(Rows.Count, 2).End(xlUp).Row).Copy
    
    'Активируем нужную нам книгу
    Workbooks("KONG.xlsm").Activate
    Sheets.Add.Name = "worktop2"
    ActiveSheet.Paste

    Columns("C:C").Insert
    Range("C2", Cells(Rows.Count, "C").End(xlUp)).Offset(, 1).FormulaR1C1 = "=""=Delete_Rus(RC[-1])"

End Sub

Workbooks.Open ("..\orders\rcvd-orders\KONG.xlsm")

Next ws
labelexit:

Sub file_open()
'fasting settings
Application.Calculation = xlManual
Application.ScreenUpdating = False
 
Dim wb_base_name As String, rinok_nash_order_column As Integer, ordernum As String, ws_base_name As String, wb_order_name As String, ws_order_name As String, wb As Workbook, ws As Worksheet, model(9999) As String, color(9999) As String, quantity(9999) As Integer, position(9999) As Integer, skin(9999) As Integer, skinrow(9999) As Integer, modwcolor As String, numrow As Integer, cur_sym_pos As Integer, order_column As Integer, filename As String, lrib As Integer
 
'open file dialog window
ChDir ThisWorkbook.Path & "\"
impfilename = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", 2, "Выбрать текстовые или Excel файлы", , False)
If impfilename = "False" Then Exit Sub
 
wb_base_name = ActiveWorkbook.Name
ws_base_name = ActiveWorkbook.ActiveSheet.Name
 
Set wb = Application.Workbooks.Open(impfilename)
filename = wb.Name
wb_order_name = wb.Name
For Each ws In wb.Worksheets
    ws_order_name = ws.Name
    'from managers
     
     
    'detect columns nums
    Dim col_num_nazv, col_num_model, col_num_kol, col_num_last As Integer
    For q = 1 To 99
        If Right(ws.Cells(1, q), 6) = "Модель" Then col_num_model = q
        If Right(ws.Cells(1, q), 10) = "Количество" Then col_num_kol = q
        If ws.Cells(1, q) <> "" Then col_num_last = q
    Next q
 
 
    If col_num_nazv <> "" And col_num_model <> "" Then
        from_manager = True
        For i = 1 To Len(wb.Name)
                If IsNumeric(Mid(wb.Name, i, 1)) Then ordernum = ordernum + Mid(wb.Name, i, 1)
                If Mid(wb.Name, i, 1) = " " And Len(ordernum) > 0 Then Exit For
        Next i
        filename = "№" + ordernum + "-"
         
         
        'reading order
        For numrow = 2 To 9999
            If ws.Cells(numrow, col_num_model) = "" Then Exit For
                If Len(ws.Cells(numrow, col_num_model)) = 1 Then model(numrow - 1) = "0000" + CStr(ws.Cells(numrow, col_num_model))
                If Len(ws.Cells(numrow, col_num_model)) = 2 Then model(numrow - 1) = "000" + CStr(ws.Cells(numrow, col_num_model))
                If Len(ws.Cells(numrow, col_num_model)) = 3 Then model(numrow - 1) = "00" + CStr(ws.Cells(numrow, col_num_model))
                If Len(ws.Cells(numrow, col_num_model)) = 4 Then model(numrow - 1) = "0" + CStr(ws.Cells(numrow, col_num_model))
                If Len(ws.Cells(numrow, col_num_model)) = 5 Or Len(ws.Cells(numrow, 2)) = 7 Then model(numrow - 1) = ws.Cells(numrow, col_num_model)
                quantity(numrow - 1) = Int(ws.Cells(numrow, col_num_kol))
             
            modwcolor = ws.Cells(numrow, col_num_nazv)
             
            If Left(ws.Cells(1, col_num_nazv), 1) <> "*" And Left(ws.Cells(1, col_num_nazv), 2) <> "ш-" Then skin(numrow - 1) = 0
            If Left(ws.Cells(1, col_num_nazv), 1) = "*" Then skin(numrow - 1) = 1
            If Left(ws.Cells(1, col_num_nazv), 2) = "ш-" Then skin(numrow - 1) = 2
            'selecting color from modwcolor
            For cur_sym_pos = Len(modwcolor) - 1 To 1 Step -1
                If IsNumeric(Mid(modwcolor, cur_sym_pos, 1)) Or Mid(modwcolor, cur_sym_pos, 1) = "-" Then
                    color(numrow - 1) = Right(modwcolor, Len(modwcolor) - cur_sym_pos)
                    Exit For
                End If
            Next cur_sym_pos
            color(numrow - 1) = UCase(Replace(color(numrow - 1), " ", ""))
        Next numrow
 
         
        numrow = numrow - 2
        lrib = last_row_in_base(wb_base_name, ws_base_name)
        order_column = new_order(wb_base_name, ws_base_name, filename, lrib)
        filename = filename + CStr(find_containers(model, color, quantity, position, skin, skinrow, numrow, wb_base_name, ws_base_name, lrib, order_column, wb_order_name, ws_order_name, "manager", rinok_nash_order_column)) + "шт-Резерв-" + InputBox("Введите инициалы менеджера", "Запрос")
        numrow = numrow + 1
 
 
             
            Workbooks(wb_order_name).Activate
            Worksheets(ws_order_name).Activate
            ws.Range(Cells(1, col_num_last + 1).Address, Cells(numrow, col_num_last + 1).Address).Copy ws.Cells(1, 30)
            ws.Cells(1, 30) = "Не отгружено"
            ws.Range(Cells(1, col_num_nazv).Address, Cells(numrow, col_num_nazv).Address).Copy ws.Cells(1, 27)
            ws.Range(Cells(1, col_num_kol).Address, Cells(numrow, col_num_kol).Address).Copy ws.Cells(1, 28)
            ws.Range(Cells(1, col_num_last).Address, Cells(numrow, col_num_last).Address).Copy ws.Cells(1, 29)
            ws.Cells(1, 29) = "Отгружено"
            ws.Range("AA1:AA" + CStr(numrow) + ",AB1:AB" + CStr(numrow) + ",AC1:AC" + CStr(numrow) + ",AD1:AD" + CStr(numrow)).Copy
            'ws.Range("AA1:AA99999,AB1:AB99999,AC1:AC99999,AD1:AD99999").Copy
        Workbooks.Add
        ActiveSheet.Paste Destination:=Range("A1")
        Application.DisplayAlerts = False
        Rows("1:1000").RowHeight = 15
        Columns("A:H").AutoFit
        'Cells(numrow + 1, 3) = "=СУММ(C2:C" + CStr(numrow) + ")"
        Cells(numrow + 1, 4) = Application.WorksheetFunction.Sum(Columns("D:D"))
        Cells(numrow + 1, 3) = Application.WorksheetFunction.Sum(Columns("C:C"))
        'Cells(numrow + 1, 2) = "=СУММ(B2:B" + CStr(numrow) + ")"
        Cells(numrow + 1, 2) = Application.WorksheetFunction.Sum(Columns("B:B"))
        ActiveWorkbook.SaveAs _
        filename:=".\отправка\" + filename + ".xlsx"
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
 
         
        Workbooks(wb_base_name).Activate
        Worksheets(ws_base_name).Activate
        Cells(1, order_column) = filename
        Workbooks(wb_order_name).Activate
        Worksheets(ws_order_name).Activate
        GoTo labelexit
         
    End If
 
wb.Close (0)
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub
Function last_row_in_base(wb_base_name As String, ws_base_name As String) As Integer
    Workbooks(wb_base_name).Activate
    Worksheets(ws_base_name).Activate
    'find last row
    For i = 9999 To 1 Step -1
        If Cells(i, 16) <> "" Then last_row_in_base = i: Exit For
    Next i
End Function
 
Function new_order(wb_base_name As String, ws_base_name As String, filename As String, lrib As Integer) As Integer
    Workbooks(wb_base_name).Activate
    Worksheets(ws_base_name).Activate
    'find last column
    For i = 28 To 9999
        If Cells(2, i) <> "" And Cells(3, i) <> "" And Cells(4, i) <> "" And Cells(5, i) <> "" Then new_order = i + 1
    Next i
    'copy previous columns to new order
    Cells(2, new_order) = Format(Date, "dd\/mm")
    Cells(2, new_order + 1) = Format(Date, "mm\/dd")
    Cells(2, new_order + 2) = Format(Date, "dd\/mm")
    Cells(2, new_order + 3) = Format(Date, "mm\/dd")
    Cells(1, new_order).Interior.color = 65535
    Cells(2, new_order).Interior.color = 65535
    Cells(1, new_order + 2).Interior.color = 65535
    Cells(2, new_order + 2).Interior.color = 65535
 
    For i = 3 To lrib
        Cells(i, new_order).Interior.color = 65535
        Cells(i, new_order + 1) = "=RC[-2]-RC[-1]"
        Cells(i, new_order + 2).Interior.color = 65535
        Cells(i, new_order + 3) = "=RC[-2]-RC[-1]"
    Next i
End Function
Function find_containers(model() As String, color() As String, quantity() As Integer, position() As Integer, skin() As Integer, skinrow() As Integer, numrow As Integer, wb_base_name As String, ws_base_name As String, lrib As Integer, order_column As Integer, wb_order_name As String, ws_order_name As String, order_type As String, rinok_nash_order_column As Integer) As Integer
    Dim text As String, all_cont_sum As Integer
    Workbooks(wb_base_name).Activate
    Worksheets(ws_base_name).Activate
    Dim containers(99, 2) As Integer
    Dim cont_num As Integer, quantity_sum As Integer, balance As Integer, container_found As Boolean, skirow_found As Boolean, skincolumnplus As Integer
 
    For i = 1 To numrow
        Erase containers
        container_found = False
        skinrow_found = False
        cont_num = 0
        quantity_sum = 0
        skincolumnplus = 0
        balance = 0
 
        'run across all containers
       For baserow = 1 To lrib
 
        'calculate skincolumnplus
        If skin(i) = 1 Or (order_type = "manager" And skinrow_found = True And skin(i) <> 2) Then skincolumnplus = 2
 
        'sorting containers massive
        Dim tmp As Integer, tmp2 As Integer
        For isrt = 1 To cont_num - 1
            For jsrt = 1 To cont_num - isrt
                If containers(jsrt, 2) > containers(jsrt + 1, 2) Then
                    tmp = containers(jsrt, 1)
                    tmp2 = containers(jsrt, 2)
                    containers(jsrt, 1) = containers(jsrt + 1, 1)
                    containers(jsrt, 2) = containers(jsrt + 1, 2)
                    containers(jsrt + 1, 1) = tmp
                    containers(jsrt + 1, 2) = tmp2
                    End If
            Next jsrt
        Next isrt
 
        'if skinrow not found, writing to the order and going to next orderrow
        If skin(i) <> 0 And skinrow_found = False Then
            Workbooks(wb_order_name).Activate
            Worksheets(ws_order_name).Activate
            If order_type = "manager" Then
                If Cells(1, 6) = "Количество" Then
                    Cells(i + 1, 8) = Cells(i + 1, 8) + 0
                    Cells(i + 1, 8).Interior.color = 255
                    Cells(i + 1, 9) = Cells(i + 1, 9) + quantity(i)
                    Cells(i + 1, 9).Interior.color = 255
                Else
                    Cells(i + 1, 9) = Cells(i + 1, 9) + 0
                    Cells(i + 1, 9).Interior.color = 255
                    Cells(i + 1, 10) = Cells(i + 1, 10) + quantity(i)
                    Cells(i + 1, 10).Interior.color = 255
 
                End If
 
            Workbooks(wb_base_name).Activate
            Worksheets(ws_base_name).Activate
            GoTo nexi
        End If
 
                 
        'if all container quantity is enought
        If quantity_sum >= quantity(i) Then
            'search postion in one container
            For isrt = 1 To cont_num
                If containers(isrt, 2) >= quantity(i) Then
                    'write to container to order in base
                    Cells(containers(isrt, 1), order_column + skincolumnplus) = Cells(containers(isrt, 1), order_column + skincolumnplus) + quantity(i)
                    'write data to skinrow
                    If (skin(i) = 1 And skinrow_found = True) Or (order_type = "manager" And skinrow_found = True And skin(i) <> 2) Then
                        Cells(skinrow(i), order_column) = Cells(skinrow(i), order_column) + quantity(i)
                        Cells(skinrow(i), order_column + 2) = Cells(skinrow(i), order_column + 2) - quantity(i)
                    End If
 
                    container_found = True
                    Exit For
                End If
            Next isrt
 
 
            If quantity_sum = 0 Then
             
                'write zero to base
                If containers(0, 1) > 0 Then If Cells(containers(0, 1), order_column + skincolumnplus) = "" Then Cells(containers(0, 1), order_column + skincolumnplus) = 0
                If (skin(i) = 1 And skinrow_found = True) Or (order_type = "manager" And skinrow_found = True And skin(i) <> 2) Then
                    Cells(skinrow(i), order_column) = Cells(skinrow(i), order_column) + 0
                    Cells(skinrow(i), order_column + 2) = Cells(skinrow(i), order_column + 2) - 0
                End If
  
 
nexi:
    Next i
find_containers = all_cont_sum
End Function
 
Sub file_import()
file_open
End Sub

Range("A2", Cells(Rows.Count, 6).End(xlUp)).Select

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