Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Application.CutCopyMode = False
End Sub

        For Each shp In Sheets(2).Shapes
            If shp.TopLeftCell.Address = r.Next.Address Then
                shp.Copy
                Cells(i, 2).PasteSpecial xlPasteAll
                Exit for
            End If
        Next

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_SETTEXT = &HC

Private Sub test_sub()
    Dim Ret As Long, ChildRet As Long, sString As String
    sString = "test_string"
    Ret = Shell("notepad.exe", vbNormalFocus)
    DoEvents
    Ret = FindWindow(vbNullString, "Безымянный — Блокнот")
    If Ret = 0 Then
        MsgBox "Нема нотпаду"
        Exit Sub
    End If
    ChildRet = FindWindowEx(Ret, ByVal 0&, "Edit", vbNullString)
    SendMessage ChildRet, WM_SETTEXT, 0, ByVal sString
End Sub

Application.DisplayAlerts = False 

Sub test()
    oDates = Range("A2:A38").Value
    For i = LBound(oDates) To UBound(oDates)
        oDates(i, 1) = CDate(oDates(i, 1))
    Next i
    Range("A2:A38").Value = oDates
End Sub

Sub SplitNames()
m1 = Sheets("Начальные данные").Range("A2:C10").Value
n = 1
For i = LBound(m1) + 1 To UBound(m1)
    A = Split(m1(i, 3), ", ")
    n = n + UBound(A) + 1
Next i
ReDim m2(1 To n + 1, 1 To 3)
n = 1
For i = LBound(m1) To UBound(m1)
    A = Split(m1(i, 3), ", ")
    For j = LBound(A) To UBound(A)
        If A(j) <> "" Then
            For k = 1 To UBound(m1, 2)
                m2(n, k) = m1(i, k)
            Next k
            m2(n, UBound(m1, 2)) = A(j)
            n = n + 1
        End If
    Next j
Next
Sheets("Итог").Range("A2:C" & UBound(m2)).Value = m2
End Sub

arr = Array("Az", "Bz", "Cz" ...) ' - тут 31 диапазон
for i = 1 to 31
with Worksheets(i).Range(arr(i-1)) ' arr(i-1) потому что массив начинается с 0
Ax = .Columns(7).Formula 
.Columns(7).Value = 1
'...
'некоторое действие
'...
.Columns(7).Formula = Ax
end with
next i

=ЕСЛИ(O2<90%;0;ЕСЛИ(O2>110%;Q2*1,1;O2*Q2))

        <string1>03</string1>
        <string2>16.03.2021</string2>
        <string3>Компания 3</string3>
        <string4>20.05.2021</string4>

Sub findName()
endRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A1:A" & endRow).Value
For i = LBound(arr) To UBound(arr)
    For j = i + 1 To UBound(arr)
        If Len(arr(i, 1)) < Len(arr(j, 1)) Then
            Temp = arr(j, 1)
            arr(j, 1) = arr(i, 1)
            arr(i, 1) = Temp
        End If
    Next j
Next i
arr1 = Range("C1:D" & endRow).Value
For i = LBound(arr1) To UBound(arr1)
    For j = LBound(arr) To UBound(arr)
        If InStr(1, arr1(i, 1), arr(j, 1)) > 0 Then arr1(i, 2) = arr(j, 1): Exit For
    Next j
    If arr1(i, 2) = "" Then
        For j = LBound(arr) To UBound(arr)
        DoEvents
            tmp = Split(arr(j, 1), " ")
            For m = UBound(tmp) To LBound(tmp) Step -1
                Temp = ""
                For n = LBound(tmp) To m
                    Temp = Temp & " " & tmp(n)
                Next n
                Temp = Trim(Temp)
                If InStr(1, arr1(i, 1), Temp) > 0 Then arr1(i, 2) = arr(j, 1): Exit For
            Next m
            If arr1(i, 2) <> "" Then Exit For
        Next j
    End If
Next i
Range("C1:D" & endRow).Value = arr1
End Sub

=СЧЁТЕСЛИМН(Таблица1[Дробное сначение];">1,5";Таблица1[Дробное сначение];"<2";
Таблица1[Текстовый критерий1];"A";
Таблица1[Текстовый критерий2];"E";
Таблица1[Дробное значение2];">1,5";Таблица1[Дробное значение2];"<2")

Public Declare PtrSafe Function MoveWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal x As LongPtr, ByVal y As LongPtr, ByVal nWidth As LongPtr, ByVal nHeight As LongPtr, ByVal bRepaint As LongPtr) As LongPtr
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private start As Boolean

Sub ResizeMe()
    Dim hwnd As LongPtr
    start = True
    While (start And hwnd = 0)
        DoEvents
        hwnd = FindWindow(vbNullString, "Найти и заменить")
        hwnd = MoveWindow(hwnd, 100, 100, 900, 700, 1)
    Wend
End Sub

Sub endSub()
start = False
End Sub

endRow = ws.UsedRange.Rows.Count
arr = ws.Range("A2:H" & endRow).Value
For i = LBound(arr) To UBound(arr)
    If arr(i, longrun_column) <> "-" And arr(i, longrun_column) <> "" Then
      If Replace(arr(i, longrun_column), ".", ":") >= Replace(Result, ".", ":") Then Points_results_4 = arr(i, 1): Exit Function
    End If
Next i

=ДВССЫЛ("'"&"0"&ЛЕВСИМВ(ПСТР(ЯЧЕЙКА("имяфайла";A1);НАЙТИ("]";ЯЧЕЙКА("имяфайла";A1))+1;255);2)-1&ПСТР(ЯЧЕЙКА("имяфайла";A1);НАЙТИ("]";ЯЧЕЙКА("имяфайла";A1))+3;255)&"'"&"!q23")-M23-T23