// Процедура копирует первый лист из книги ПутьИмяЛиста 
// в книгу ПутьИмяКнигиОтчетов и присваивает этому листу имя НовоеИмяЛиста.
// Если книги ПутьИмяКнигиОтчетов еще нет - она создается
// Если в книге ПутьИмяКнигиОтчетов уже есть лист с именем НовоеИмяЛиста - он заменяется на новый
Процедура ПеренестиОтчетВКнигуExcel(ПутьИмяКнигиОтчетов, ПутьИмяЛиста, НовоеИмяЛиста,Ном) Экспорт
    // Дотянуться до Экселя
    Попытка
        Эксель = СоздатьОбъект("Excel.Application");
    Исключение
        Предупреждение("У Вас на компьютере не установлен Microsoft Excel. Импорт невозможен!");
        Возврат;
    КонецПопытки;
    // Сам Эксель невидимый
    Эксель.Visible = 0;    
    // И лишних вопросов задавать не должен
    Эксель.DisplayAlerts = 0;
    // Получить книгу из параметра ПутьИмяКнигиОтчетов
    Попытка                          
        КнигаОтчетов = Эксель.Workbooks.Open(ПутьИмяКнигиОтчетов);
    Исключение
        КнигаОтчетов = Эксель.Workbooks.Add;
        КнигаОтчетов.SaveAs(ПутьИмяКнигиОтчетов);
    КонецПопытки;
    // Получить книгу из параметра ПутьИмяЛиста
    Попытка                          
        ЛистОтчета = Эксель.Workbooks.Open(ПутьИмяЛиста);
    Исключение
        Предупреждение("Не найден файл "+ПутьИмяЛиста+"!");
        Эксель = 0;
        Возврат;
    КонецПопытки;
    // Попробовать удалить отчет НовоеИмяЛиста из книги, если он уже есть
    Попытка                          
        КнигаОтчетов.Worksheets(НовоеИмяЛиста).Delete();
    Исключение
    КонецПопытки;  
    // Скопировать лист из ЛистОтчета в КнигаОтчетов:
    ЛистОтчета.Worksheets(1).Name = НовоеИмяЛиста;
    ЛистОтчета.Worksheets(1).Copy(КнигаОтчетов.Worksheets(Ном));
    ЛистОтчета.Close(0);
    КнигаОтчетов.Save();
    КнигаОтчетов.Close(-1);
    Эксель = 0;
КонецПроцедуры

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub Поместить_текущий_лист_в_архив()

    SheetsCount = ActiveWorkbook.Sheets.Count
    NameSheet = ActiveSheet.Name
    SheetsIndex = ActiveSheet.Index + 1

    ActiveSheet.Unprotect Password:="123"

    'Range("I1").FormulaR1C1 = "=RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1]"
    
    Range("I1").FormulaR1C1 = "=IFERROR(RC[-8]&RC[-7]&RC[-6]&RC[-5]&RC[-4]&RC[-3]&RC[-2]&RC[-1],""--проблемные данные--"")"
    Range("I1").Select
    
    Selection.AutoFill Destination:=Range("I1:I30"), Type:=xlFillDefault
    Range("I1:I50").Select
   
    Sheets("Архив").Unprotect Password:="123"
    Sheets("Архив").Select
    
    ExcelLastRow = Sheets("Архив").Cells.SpecialCells(xlCellTypeLastCell).Row + 1

    Numerator = ExcelLastRow
    
    For i = 1 To 50
    
        ValueI = Sheets(NameSheet).Range("I" & i).Value
        If ValueI <> "" Then
            Numerator = Numerator + 1
            Sheets(NameSheet).Range("A" & i & ":H" & i).Copy
            Sheets("Архив").Range("A" & Numerator).Select
            ActiveSheet.Paste
            Sheets("Архив").Range("A" & Numerator).Select
        End If
    
    Next
      
    Sheets("Архив").Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.DisplayAlerts = False
    If SheetsIndex <= SheetsCount Then
        Sheets(SheetsIndex).Activate
    Else
        Sheets(SheetsCount - 1).Activate
    End If
    Sheets(NameSheet).Delete
    Application.DisplayAlerts = True
    
End Sub

Sub Разблокировать_текущий_лист()

ActiveSheet.Unprotect Password:="123"

End Sub

Sub Заблокировать_текущий_лист()

ActiveSheet.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub



Sub auto_open()

Application.DisplayAlerts = False

Flag_ = False
    
DataTxt = CStr(Now)
DataTxt = Mid(DataTxt, 1, 6) + Mid(DataTxt, 9, 2)

DataTxt2 = CStr(Date + 1)
DataTxt2 = Mid(DataTxt2, 1, 6) + Mid(DataTxt2, 9, 2)

'MsgBox DataTxt2

Проверка_Время = Hour(Time) >= 18

For Each list_ In ThisWorkbook.Worksheets
   
  Проверка_Даты_На_Завтра = list_.Name = DataTxt2
  'MsgBox Проверка_Даты_На_Завтра
  Проверка_На_Завтра = Проверка_Даты_На_Завтра And Проверка_Время
  'MsgBox Проверка_На_Завтра
  Проверка_Уже_Сегодня = list_.Name = DataTxt
  'MsgBox DataTxt
  Блокируем_Лист = Проверка_На_Завтра Or Проверка_Уже_Сегодня
  'MsgBox Блокируем_Лист
   If Блокируем_Лист Then
          
         If Not list_.ProtectContents Then
            list_.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True
            Flag_ = True
         End If
   
   End If
Next

Sheets("Архив").Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True

If Flag_ Then
    ThisWorkbook.Save 'SaveChanges:=True
End If

Application.DisplayAlerts = True

End Sub

Sub Регсчетчика1_Изменение()

    On Error GoTo Metka1
    
    Range("C1").FormulaR1C1 = "=RC[10]+41608"
    Txt = Range("C1").Text
    Range("C1").FormulaR1C1 = Txt
    
    If ActiveSheet.Name <> "Бланк" Then
    
    ActiveSheet.Name = Mid(Txt, 1, 6) + Mid(Txt, 9, 2)
    
    End If
    GoTo Ends:
    

Metka1:
MsgBox "Такой лист уже есть!"
Ends:

End Sub

Sub Пятно11_Щелчок()

    КоличествоЛистов = ThisWorkbook.Worksheets.Count
    День = ActiveSheet.Range("M1").Value + 1
     
    If ActiveSheet.Name <> "Бланк" Then
     Sheets("Бланк").Copy After:=Sheets(КоличествоЛистов)
    End If
    
    Sheets(КоличествоЛистов + 1).Visible = True
    Sheets(КоличествоЛистов + 1).Select
    Range("M1").FormulaR1C1 = День
    
    With ActiveWorkbook.Sheets(КоличествоЛистов + 1).Tab
        .ColorIndex = xlColorIndexNone
        .TintAndShade = 0
    End With
    
    On Error GoTo Metka1
    
    Range("C1").FormulaR1C1 = "=RC[10]+41608"
    Txt = Range("C1").Text
    Range("C1").FormulaR1C1 = Txt
    
    If ActiveSheet.Name <> "Бланк" Then
    
    ActiveSheet.Name = Mid(Txt, 1, 6) + Mid(Txt, 9, 2)
    
    End If
    GoTo Ends:
    

Metka1:
MsgBox "Такой лист уже есть!"
Ends:

End Sub

Sub ЗагрузитьДанныеИзСтарогоФайла()

f = 1

If f <> 1 Then

Application.DisplayAlerts = False
Application.ScreenUpdating = False

    ChDir "\\ftp\Exchange\xls"
    Workbooks.Open Filename:="\\ftp\Exchange\xls\Водители.xlsx", ReadOnly:=True
    
    i = 0
    
    For Each list_ In ActiveWorkbook.Sheets
      list_.Select
      list_.Rows("1:30").Select
      Selection.Copy
      Windows("!Водители.xlsm").Activate
      Sheets("Архив").Select
      Range("A" + CStr(i * 30 + 1)).Select
      ActiveSheet.Paste
      i = i + 1
      Windows("..Водители.xlsx").Activate
    Next
    
    ActiveWindow.Close SaveChanges:=False
    ActiveWorkbook.Save
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End If

End Sub
Sub Макрос2()

Application.DisplayAlerts = False

Flag_ = False
    
DataTxt = CStr(Now)
DataTxt = Mid(DataTxt, 1, 6) + Mid(DataTxt, 9, 2)

For Each list_ In ThisWorkbook.Worksheets
   If list_.Name = DataTxt Then
      If Hour(Time) >= 15 Then
         If Not list_.ProtectContents Then
            list_.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True
            Flag_ = True
         End If
      End If
   End If
Next

If Flag_ Then
    ThisWorkbook.Save 'SaveChanges:=True
End If

Application.DisplayAlerts = True

End Sub
Sub Макрос3()
'
' Макрос3 Макрос
'

'
    Sheets("Лист1").Select
    ActiveSheet.Unprotect
    Range("B6").Select
End Sub