Sub Найти()

    Dim arr(), lc As Long, j As Long
    Dim criteria1, criteria2
    
    criteria1 = Date
    criteria2 = Range("K9").Value
    lc = Cells(10, Columns.Count).End(xlToLeft).Column
    arr() = Range("A10").Resize(2, lc).Value
    For j = 16 To UBound(arr, 2)
        If arr(1, j) = criteria1 And arr(2, j) = criteria2 Then
            Cells(10, j).Select
            Exit For
        End If
    Next j

End Sub

Sub Найти()

    Dim arr(), lc As Long, j As Long, lr As Long
    Dim criteria1, criteria2
    
    criteria1 = Date
    criteria2 = Range("K9").Value
    lc = Cells(10, Columns.Count).End(xlToLeft).Column
    lr = Cells(Rows.Count, 3).End(xlUp).Row
    arr() = Rows("10:11").Value
    For j = 16 To UBound(arr, 2)
        If arr(1, j) = criteria1 And arr(2, j) = criteria2 Then
            Range(Cells(10, j), Cells(lr, j)).Select
            Exit For
        End If
    Next j

End Sub

Sub Найти()

    Dim arr(), lc As Long, j As Long
    Dim criteria1, criteria2
    
    criteria1 = Date
    criteria2 = Range("K9").Value
    lc = Cells(10, Columns.Count).End(xlToLeft).Column
    arr() = Range("A10").Resize(2, lc).Value
    For j = 16 To UBound(arr, 2)
        If arr(1, j) = criteria1 And arr(2, j) = criteria2 Then
            Cells(10, j).Select
            Exit For
        End If
    Next j

End Sub

Sub Найти()

    Dim arr(), j As Long
    Dim criteria1, criteria2
    
    criteria1 = Date
    criteria2 = Range("K9").Value
    arr() = Range("P10:GA11").Value
    For j = 1 To UBound(arr, 2)
        If arr(1, j) = criteria1 And arr(2, j) = criteria2 Then
            Range("P10:GA11").Columns(j).Select
            Exit For
        End If
    Next j

End Sub

Sub videlit()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim arr(), lc As Long, j As Long, lr As Long
Dim criteria1, criteria2
lr = Cells(Rows.Count, 3).End(xlUp).Row
criteria1 = Date
criteria2 = Range("K9").Value
lc = Cells(10, Columns.Count).End(xlToLeft).Column
arr() = Range("A10").Resize(2, lc).Value
For i = 13 To lr
For j = 16 To UBound(arr, 2)
If arr(1, j) = criteria1 And arr(2, j) = criteria2 Then
Cells(i, j).Select
Application.EnableEvents = False
If Cells(i, j).Value <> "" Then Cells(i, j + 6).Value = Cells(i, j + 6).Value + Cells(i, j).Value
Cells(i, j).ClearContents
Application.EnableEvents = True
Exit For
End If
Next j
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub videlit1()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

    Dim arr(), lc As Long, j As Long, lr As Long
    Dim criteria1, criteria2
     lr = Cells(Rows.Count, 3).End(xlUp).Row
     criteria1 = Date
     criteria2 = Range("K9").Value
     lc = Cells(10, Columns.Count).End(xlToLeft).Column
'До этой строки ничего не трогал. Новые переменные не объявлял. Патамушта лентяй
    c0_ = 16
    arr() = Cells(10, c0_).Resize(2, lc).Value 'массив меньше, там только нужные значения
    For s = c0_ To UBound(arr, 2) 'цикл по нему
        If arr(1, s) = criteria1 And arr(2, s) = criteria2 Then
            c1_ = s + c0_ - 1
            Exit For 'сразу определяем столбец для работы, а не ищем его заново для каждого прохода цикла по i
        End If
    Next s
    Application.EnableEvents = False 'Обработчик событий лучше включить один раз перед циклом
    'обычно все Application складывают вместе или вначале, или там, где начинается работа на листе
     For i = 13 To lr
'      For j = с0_ To UBound(arr, 2)
'        If arr(1, j) = criteria1 And arr(2, j) = criteria2 Then
'           Cells(i, j).Select'Зачем это?
'             Application.EnableEvents = False
            With Cells(i, c1_) 'чтобы не обращаться к ячейке несколько раз
                If .Value <> "" Then
                    .Offset(, 6).Value = .Offset(, 6).Value + .Value
                    .ClearContents
                End If
'               Cells(i, j).ClearContents'зачем стирать и так пустую ячейку?
            End With
'             Application.EnableEvents = True
'           Exit For
'        End If
'     Next j
    Next i
    Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "Всё"
End Sub