Sub qq()
    Ticker = Array("BR??", "БОЛТ", "Гайка*", "US*", "Сев*")
    For j = 1 To UBound(Ticker)
        x = [C2] Like Ticker(j)
        Cells(j + 1, 1) = [C2] Like Ticker(j)
    Next
End Sub

Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim n&, b&
    Dim Txt$
    Dim Spisok(), NewSpisok()

    If KeyCode <> 38 And KeyCode <> 40 And KeyCode <> 13 Then
        Spisok = Range("test").Value
        b = 0
        Txt = ComboBox1.Text
        If Txt = "" Then ComboBox1.List = Spisok: Exit Sub

        ComboBox1.Clear
        For n = 1 To UBound(Spisok)
            If InStr(1, Spisok(n, 2), Txt, vbTextCompare) Then
                ComboBox1.AddItem
                ComboBox1.List(ComboBox1.ListCount - 1, 0) = Spisok(n, 1)
                ComboBox1.List(ComboBox1.ListCount - 1, 1) = Spisok(n, 2)
            End If
        Next
    End If
End Sub

Sub qq()
    Dim lr&, i&
    Dim sh As Worksheet
    Application.ScreenUpdating = False
    With Sheets("Главный")
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To lr
            Sheets("Шаблон").Copy after:=Sheets(Sheets.Count)
            Set sh = Sheets(Sheets.Count)
            sh.Name = i - 1 & ". " & .Cells(i, 4).Value
            sh.Cells(1, 1).Value = .Cells(i, 1).Value
            sh.Cells(3, 1).Value = .Cells(i, 2).Value
            sh.Cells(6, 1).Value = .Cells(i, 3).Value
            sh.Cells(12, 4).Value = .Cells(i, 4).Value
            sh.Cells(16, 4).Value = .Cells(i, 5).Value
            sh.Cells(14, 4).Value = .Cells(i, 6).Value
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Sub qq()
    Dim matchRow&, endMatchRow&
    With ActiveWorkbook.Worksheets("Лист1").ListObjects("Таблица13")
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range(1), SortOn:=xlSortOnValues, _
                             Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        On Error Resume Next
        matchRow = WorksheetFunction.Match(CDbl(Range("C1")) - 1, .ListColumns(1).Range, 1)
        If Err Then matchRow = 1: Err.Clear
        endMatchRow = WorksheetFunction.Match(CDbl(Application.EoMonth(Range("C1"), 0)), .ListColumns(1).Range, 1) - 1
        .ListRows(matchRow).Range.Resize(endMatchRow - matchRow + 1).Delete
    End With

End Sub

Sub qq()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
        sh.Tab.Color = sh.Range("A1").DisplayFormat.Interior.Color
    Next
End Sub

Sub qq()
    With Selection.Parent
        .DrawingObjects.Interior.Color = 12419407
        .DrawingObjects(Application.Caller).Interior.Color = 255
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target(1).Address = "$F$2" Then
        With Sheets("Лист2").AutoFilter.Range
            .AutoFilter Field:=3, Criteria1:=[F2]
        End With
    End If
End Sub