Private Sub CommandButton2_Click()


    Dim n_str, kol_strok As Integer, big_file, file_1, StatUstr As String
    'kol_strok - число строк в загружаемом файле
    'n_str - номер первой пустой строки
    stolbs = Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 54, 55) '51 колонка с данными
    big_file = ActiveWorkbook.Name
    
    Sheets("Недельное планирование").Select
    ActiveSheet.Unprotect
    n_str = WorksheetFunction.Count(Range("A:A")) + 16
    
    FileToOpen = Application.GetOpenFilename(filefilter:="Файлы Excel(*.xlsm; *.xls; *.xlsx),*.xls; *.xlsx; *.xlsm", Title:="Выберите файл для загрузки")
    
    Application.ScreenUpdating = False
    On Error GoTo exit_
    Application.EnableEvents = False
    Workbooks.Open FileToOpen
    file_1 = ActiveWorkbook.Name
    Sheets("Недельное планирование").Select
    ActiveSheet.Unprotect
    Columns("A:BA").Select
    Application.EnableEvents = True
    On Error Resume Next
    Selection.EntireColumn.Hidden = False
    On Error Resume Next
    Worksheets("Недельное планирование").ShowAllData
    
    n_stolb = WorksheetFunction.CountA(Range("A15:DD15"))
    If n_stolb <> 55 Then
        Msg = MsgBox("Выбран некорректный файл" & Chr(13) & "Сбой.", vbOKOnly, "Внимание")
        Windows(Format(file_1)).Close (SaveChanges = False)
        GoTo exit_
    End If
    
    kol_strok = WorksheetFunction.Count(Range("A:A"))
        inform = MsgBox("Перенести " & kol_strok & " работ в сводный план из " & Chr(13) & FileToOpen & " ?", vbYesNo, "Внимание")
        If inform = vbNo Then
            Windows(Format(file_1)).Close (SaveChanges = False)
            Msg = MsgBox("Перенос отменен", vbOKOnly, "Внимание")
            Sheets("Недельное планирование").Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFiltering:=True
            Sheets("Недельное планирование").Select
            GoTo exit_
        End If

Dim sSubStr As String 'ячейка
    Dim lCol As Long 'столбец
    Dim lLastRow As Long, li As Long
    Dim arr
    Sheets("Выгрузка").Select
    sSubStr = "яблоко"
    lCol = "15"
    If lCol = 0 Then Exit Sub
 
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    arr = Cells(1, lCol).Resize(lLastRow).Value
 
    Application.ScreenUpdating = 0
    Dim pp As Range
    For li = 7 To lLastRow
        If CStr(arr(li, 1)) <> sSubStr Then
            If pp Is Nothing Then
                Set pp = Cells(li, 1)
            Else
                Set pp = Union(pp, Cells(li, 1))
            End If
        End If
    Next li
    If Not pp Is Nothing Then pp.EntireRow.Delete
    Application.ScreenUpdating = 1
    ActiveWorkbook.Save
    ActiveWindow.Close

Sub расчет()
  
    For Each w In Workbooks
    If w.Name <> ThisWorkbook.Name Then
        w.Close SaveChanges:=False
    End If
    Next w

     ActiveWorkbook.SendMail Array("AAIvanov@mail.ru", "AAPetrov@mail.ru", "AASidorov@mail.ru"), "тема"
 
End Sub