Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  On Error Resume Next
  Me.UpdateLink Me.LinkSources
End Sub
 

Sub A1
Do While ActiveCell > 0
A1 = Str(ActiveCell)
Selection.Offset(1, 0).Select
Loop
End Sub 

Sub Макрос1()
A = Range("G1")    'так фильтрует только показывает пустые, хотя в G1 число 9517
A = "9517"         'Так все работает
ActiveSheet.Range("$C$6:$C$100000").AutoFilter Field:=3, Criteria1:=Array( _
        A), Operator:=xlFilterValues
End Sub

Sub Гриф()

    X = MsgBox("Введите номер волны?", vbYesNo, "Если надо!!!")
    If X = vbYes Then
    Z = InputBox("Введите номер волны", "8 Цифр")
         Range("A1").Select
         ActiveCell.FormulaR1C1 = "1"
         Range("A2").Select
         ActiveCell.FormulaR1C1 = "2"
         Range("A3").Select
         ActiveCell.FormulaR1C1 = "3"
         Range("A4").Select
         ActiveCell.FormulaR1C1 = "4"
         Range("A5").Select
         ActiveCell.FormulaR1C1 = "5"
         Range("A6").Select
         ActiveCell.FormulaR1C1 = "6"
         Range("A7").Select
         ActiveCell.FormulaR1C1 = "7"
         Range("A8").Select
         ActiveCell.FormulaR1C1 = "8"
         Range("A9").Select
         ActiveCell.FormulaR1C1 = "9"
         Range("A10").Select
    Else
         Range("A1").Select
         ActiveCell.FormulaR1C1 = "1"
         Range("A2").Select
         ActiveCell.FormulaR1C1 = "2"
         Range("A3").Select
         ActiveCell.FormulaR1C1 = "3"
         Range("A4").Select
         ActiveCell.FormulaR1C1 = "4"
         Range("A5").Select
         ActiveCell.FormulaR1C1 = "5"
         Range("A6").Select
         ActiveCell.FormulaR1C1 = "6"
         Range("A7").Select
         ActiveCell.FormulaR1C1 = "7"
         Range("A8").Select
         ActiveCell.FormulaR1C1 = "8"
         Range("A9").Select
         ActiveCell.FormulaR1C1 = "9"
         Range("A10").Select
  End If
End Sub

Sub Макрос1()
If Workbooks.Open("C:\Users\Dispetcher2\Desktop\11111.xlsx", , , , "00000") Then
Workbooks.Open "C:\Users\Dispetcher2\Desktop\11111.xlsx", , , , "55555"
End If
End Sub

Sub Время()
If MsgBox("Выделил ячейку?", vbYesNo) = vbYes Then
Dim n As Long
        n = InputBox("С какого номера начать?")
Dim m As Long
        m = InputBox("Какое количество маршрутов нужно сформировать?")
       For n = n To m
        ActiveCell.FormulaR1C1 = n
        Selection.Offset(1, 0).Select
Next n
 Else
 End If

End Sub

Sub Stol()
Dim n As Long
n = 1
Dim m As Long
m = InputBox("Какое количество чисел нужно сформировать")
ActiveCell = n
Dim oRange
Set oRange = Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row + m - 1, ActiveCell.Column))
oRange.Formula = n
n = n + 1
End Sub

        Range("L7:L" & Cells(Rows.Count, 1).End(xlUp).Row).Formula = "=RC[1]+R3C21"
        Dim i As Range
        Set i = Range("M6:M1000").Cells.Find(What:=TimeSerial(0, 0, 0))
        If Not i Is Nothing Then i.Offset(0, -1).Activate
        ActiveCell.FormulaR1C1 = "=RC[1]+R3C21+1"

 Dim i As Range
        Set i = Range("M6:M1000").Find("*" & "14:00:00" & "*", , , xlWhole)
        If Not i Is Nothing Then i.Offset(0, 0).Activate

Windows("Новейший пропуск 28.01.2015.xlsm").Activate
Sheets("Планнинг").Select 

Sub Макрос15()
    'R = Selection.Offset(0, -6).Select
    R = InputBox("В каком замена?", "Васёк")
    Dim c As Range
    Set c = Range("A1:A1000").Find("*" & R & "*", , , xlWhole)
    If Not c Is Nothing Then c.Offset(0, 18).Activate

End Sub

 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vVal
Dim StrVal As String
    Application.EnableEvents = False
    If Not Intersect(Target, Range("P:S")) Is Nothing Then
        With Target
        Application.EnableEvents = True
            vVal = Format(.Value, "0000")
             Application.EnableEvents = False
            If IsNumeric(vVal) And Len(vVal) = 4 Then
                .Value = Left(vVal, 2) & ":" & Right(vVal, 2)
                .NumberFormat = "[h]:mm"
            End If
        End With
     End If
     If Not Intersect(Target, Range("T:T")) Is Nothing Then
        If IsNumeric(Target) Then
              If Len(Target) > 1 Then Target = Target / 10
              Target.NumberFormat = "#.0"
        End If
  End If
  Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("Y7:Y1000")) Is Nothing Then
    R = InputBox("Какой маршрут?", "Васёк")
Dim c As Range
    Set c = Range("A1:A1000").Find("*" & R & "*", , , xlWhole)
    If Not c Is Nothing Then c.Offset(0, 15).Activate
End If
End Sub
 

  For Each c In [a1:o20]
    If c.Value = [q1].Value Then c.ClearContents
  Next 

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

'
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Selection.Copy
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vVal
Dim StrVal As String
     
    If Not Intersect(Target, Range("P:S")) Is Nothing Then
        With Target
            vVal = Format(.Value, "0000")
            If IsNumeric(vVal) And Len(vVal) = 4 Then
                Application.EnableEvents = False
                .Value = Left(vVal, 2) & ":" & Right(vVal, 2)
                .NumberFormat = "[h]:mm"
            End If
        End With
     End If
     Application.EnableEvents = True
 
End Sub