Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("E2:E10000")) Is Nothing Then
        If Range("E" & Target.Row) <> "" Then
           i = Cells(Split(Target.Address, "$")(2), 2)
           With Sheets("Лист1")
                For s = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
                    If .Cells(s, 2) = i Then
                       .Cells(s, 5) = "Гараж"
                       .Cells(s, 3) = ""
                       .Cells(s, 4) = ""
                    End If
                Next
          End With
        End If
    End If
end sub

Private Sub Workbook_Open()
Application.OnTime TimeValue("08:25:00"), "макрос1"
Application.OnTime TimeValue("08:30:00"), "макрос2"
Application.OnTime TimeValue("16:00:00"), "макрос3"
Application.OnTime TimeValue("15:45:00"), "макрос4"
End Sub

Sub Test2()
Dim Rng As Range, rCell As Range
    Set Rng = Range("I2:I25")
    For Each rCell In Rng
        If IsEmpty(rCell) Or rCell = 0 Then
            MsgBox "найдено" & rCell.Address(0, 0), 64, "поиск"
            Exit For
        End If
    Next
End Sub

    Range("A1:AV27").Select
    Range("AV27").Activate
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    Range("C5:AV24").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("4:4").RowHeight = 69
    Rows("26:26").RowHeight = 110
    Rows("25:25").RowHeight = 165
    Range("A2:B4").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Отчет.xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        ActiveWindow.Zoom = 60
    ActiveWindow.DisplayZeros = False
    Range("AF1:AP1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1:AE1").Select
   End Sub

ActiveWorkbook.SaveAs Filename:= _
        "C:\Отчет.xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

Sub заповнитисправа1()
Dim i As Integer
 
For i = 3 To Columns.Count
    If Application.WorksheetFunction.CountA(Columns(i).Resize(25)) = 0 Then
        Columns(i).Resize(304).Value = Columns(14).Resize(304).Value
        Exit Sub
    End If
Next i

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = "карта" Then
  Sheets("лист3").Select
  Else
  Sheets("лист4").Select
  End If
End Sub

If Target.Value = "карта" Then

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim shName$
  If Target.Value = "Відпустка" Then
     shName$ = "Лист3"
     lRw = Application.Match(Target.Offset(0, -4), Range("b1:b6"), 0)
          
     ElseIf Target.Value = "Лікарняне" Then
     shName$ = "Лист2"
     lRw = Application.Match(Target.Offset(0, -4), Range("b1:b6"), 0)
               
Else
Exit Sub
End If
    Range("C6:D6").Select
    Selection.Copy
     With Sheets(shName$)
     .Activate
     .Cells(lRw, 4).Select
     ActiveSheet.Paste
End With
End Sub

 Range("C6:D6").Select

Private Sub Worksheet_Change(ByVal Target As Range)
                 Dim lRw As Long
     If Not Application.Intersect(Range("f:f"), Target) Is Nothing And Target.Address <> Target.EntireRow.Address Then
        With Sheets("лист2")
            lRw = Application.Match(Target.Offset(0, -4), .Range("c1:c6"), 0)
            .Activate
            .Cells(lRw, 4).Select
          End With
          End If
          End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
                 Dim lRw As Long
     If Not Application.Intersect(Range("d:d"), Target) Is Nothing And Target.Address <> Target.EntireRow.Address Then
        With Sheets("лист2")
            lRw = Application.Match(Target.Offset(0, -2), .Range("c1:c6"), 0)
            .Activate
            .Cells(lRw, 4).Select
          End With
          End If
          End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim lRw As Long
    If Not Application.Intersect(Range("D:D"), Target) Is Nothing Then
               With Sheets("Дані")
               lRw = Application.Match(Target.Offset(0, 1), .Range("C:C"), 0)
            .Activate
            .Cells(lRw, 3).Select
            Selection.End(xlDown).Select
            Selection.End(xlDown).Select
            ActiveCell.Offset(1).Select
           
        End With
          End If
         
          Application.ScreenUpdating = True
        
          End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim KeyCells As Range
   Set KeyCells = Range("А1:А10")
   
   If Not Application.Intersect(KeyCells, Range(Target.Address)) _
          Is Nothing Then
       Sheets("Лист2").Range("B1").Select '
   End If
End Sub