Sub CopySelectedSheetsScheduledNoOpen()
    Dim SourceWorkbook As Workbook
    Dim DestinationWorkbook As Workbook
    Dim SourceSheet As Worksheet
    Dim DestinationSheet As Worksheet
    Dim LastRow As Long
    Dim LastCol As Long
    Dim SourceRange As Range
    Dim ScheduledTime As Date
    Dim FilePath As String
    
   'Путь к файлу
    FilePath = "\\bee.vimpelcom.ru\folders\MoscowTverScheduler\Teleopti\Единый РКЦ\Единый мониторинг\Свешников\макрос тест — 2листа — копия.xlsm"
    
    'Задать время для запуска макроса (например,каждый день в 8:41)
    ScheduledTime = DateSerial(Year(Now()), Month(Now()), Day(Now())) + TimeSerial(8, 41, 0)
    
    'Проверить, соответствует ли текущее время заданному времени
    If Now() < ScheduledTime Then Exit Sub
    
    'Открыть файл без отображения
    Set SourceWorkbook = Workbooks.Open(FilePath, UpdateLinks:=False, ReadOnly:=True)
    Set DestinationWorkbook = Workbooks.Open(FilePath, UpdateLinks:=False, ReadOnly:=False)
    
    'Копировать данные с нескольких листов
    CopySheetData SourceWorkbook, DestinationWorkbook, "Лист2", "Лист1"
    CopySheetData SourceWorkbook, DestinationWorkbook, "Лист4", "Лист3"
    'Добавить больше вызовов CopySheetData для других пар листов при необходимости
    
    'Сохранить и закрыть файлы
    DestinationWorkbook.Save
    SourceWorkbook.Close False
    DestinationWorkbook.Close True
End Sub
Private Sub CopySheetData(SourceWB As Workbook, DestWB As Workbook, SourceSheetName As String, DestSheetName As String)
    Dim SourceSheet As Worksheet
    Dim DestinationSheet As Worksheet
    Dim LastRow As Long
    Dim LastCol As Long
    Dim SourceRange As Range
    
    'Указать исходный и целевой листы
    Set SourceSheet = SourceWB.Worksheets(SourceSheetName)
    Set DestinationSheet = DestWB.Worksheets(DestSheetName)
    
    'Найти последнюю используемую строку и столбец на исходном листе
    LastRow = SourceSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastCol = SourceSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    
    'Установить диапазон для копирования
    Set SourceRange = SourceSheet.Range(SourceSheet.Cells(1, 1), SourceSheet.Cells(LastRow, LastCol))
    
    'Скопировать данные как значения на целевой лист
    SourceRange.Copy
    DestinationSheet.Range("A1").PasteSpecial Paste:=xlPasteValues
    
    'Очистить буфер обмена
    Application.CutCopyMode = False
End Sub