Private Sub ComboBox1_Change()
For i = ListBox2.ListCount - 1 To 0 Step -1
If ListBox2.List(i, 0) <> ComboBox1.Value Then
    ListBox2.RemoveItem (i)
End If
Next
ComboBox2.List = UniqueSortArr(1)
ListBox2.List = ListBox1.List
ComboBox2.ListIndex = -1
End Sub

Sub Workbook_Open() 
Call ProtectionSheets 
   If Time < TimeValue("16:20:00") Then tStart = TimeValue("16:20:00") 
   If Time < TimeValue("15:00:00") Then tStart = TimeValue("15:00:00") 
   If Time < TimeValue("12:00:00") Then tStart = TimeValue("12:00:00") 
   If Time < TimeValue("10:00:00") Then tStart = TimeValue("10:00:00") 
   If tStart > 0 Then Application.OnTime tStart, "SaveCopy" 
End Sub 

Sub SaveCopy() 
Dim DefaultPath$, DefaultName$ 
DefaultPath = "\\192.168.1.1\common\Оснастка\Архив Файла Штампы\" 
   ' DefaultName = Format(Date, "DD.MM.YY - ") & Format(Time, "HH.MM") & "_" & ThisWorkbook.Name 
   DefaultName = Format(Now, "DD.MM.YY - hh.nn") & "_" & ThisWorkbook.Name 
   ThisWorkbook.SaveCopyAs (DefaultPath & DefaultName)  

   If tStart = TimeValue("16:20:00") Then 
      Me.Close saveChanges:=True 
   Else 
      If tStart < TimeValue("15:00:00") Then 
         tStart = tStart + TimeSerial(2, 0, 0) 
      Else 
         tStart = tStart + TimeSerial(1, 20, 0) 
      End If 
   End If  

   Application.OnTime tStart, "SaveCopy" 
End Sub 

Private Sub Workbook_BeforeClose(Cancel As Boolean) 
   On Error Resume Next 
   Application.OnTime tStart, "SaveCopy", , False 
End Sub