Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
    On Error GoTo konets
        If Not IsNumeric(Target.Cells(1, 1).Value) Then Exit Sub
        Application.EnableEvents = False
        [A2].Value = Round(Target.Cells(1, 1).Value / 2.54, 2)
        [B2].Value = Round(Target.Cells(1, 1).Value * 2.54, 2)
konets: Application.EnableEvents = True
End Sub

Option Explicit

Sub abc_xyz()
    Dim c%, cl%, r&, rw&, nr&
    Dim sh As Worksheet
    
    With ThisWorkbook
        Set sh = .Sheets("ГОД")
        rw = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
        cl = 15
        
        For c = 4 To cl
            With .Sheets(sh.Cells(7, c).Value) ' названия месяцев <=> заголовки таблицы
                '.Select
                nr = 6
                For r = 8 To rw
                    If Trim(sh.Cells(r, c).Value) <> "" Then
                        .Range("A" & nr & ":D" & nr).Value = Array(nr - 5, sh.Cells(r, "B").Value, sh.Cells(r, "C").Value, sh.Cells(r, c).Value)
                        nr = nr + 1
                    End If
                Next
            End With
        Next
        
        Set sh = Nothing
    End With
    
    MsgBox "Сделано"
End Sub

Sub WriteSERVICE(control As IRibbonControl)
    '...
    Next
    
    Dim dostup$
    dostup = Trim(InputBox("Pozhaluysta, vvedite bukvu stolbtsa s putem k katalogu", "Put' k faylam", "B"))
    If dostup = "" Then Exit Sub
    
    ss = ThisWorkbook.Path & Application.PathSeparator
    ss = ss & Cells(3, dostup).Value & "_" & Format(Now, "dd-mm-yy-hh-mm-ss") & "_SERVICE" & ".txt"
    
    n = FreeFile
    Open ss For Output As #n
    Print #n, s
    Close #n
    '...
End Sub

Set wsUnload = ActiveSheet

& Cells(3, 2) &

wsUnload.Cells(wsUnload.Rows.Count, 7).Value

wsUnload.Rows.Count

[B1].Value = "=NOT((COUNTIF(A1,""*sale*"")+COUNTIF(A1,""*order*"")))"

=NOT((COUNTIF(A1,"*sale*")+COUNTIF(A1,"*order*")))

Option Explicit

Sub bezhi_do_yezhi_1()
    Dim pos%, r&, nzvLista$, adrYach$, frmla, prmtr             ' Ob"yavleniya peremennykh
    r = 2                                                       ' Nachinayem so vtoroy stroki
    With Sheets("Svodnaya")                                     ' na liste "Svodnaya"
        Do Until .Cells(r, "C").Value <> "a"                    ' Poka w yacheykakh bukva "a"
            r = r + 1                                           ' bezhit' po stolbtsy "C"
        Loop                                                    '
        frmla = .Cells(r, "C").Formula                          ' Poluchayet formulu iz yacheyki
    End With
    pos = InStr(1, frmla, "!", 1)                               ' Opredelyayet polozheniye vosklitsatel'nogo znaka "!"
    nzvLista = Mid(frmla, 2, pos - 2)                           ' Vydelyayet nazvaniye lista "Raschet"
    adrYach = Mid(frmla, pos + 1, Len(frmla) - pos)             ' Vydelyayet adres yacheyki "K12"
    prmtr = Sheets(nzvLista).Range(adrYach).Offset(0, 1).Value  ' Poluchayet parametr
    MsgBox prmtr
End Sub

Sub bezhi_do_yezhi_2()
    Dim r&, frmla, prmtr
    r = 2
    With Sheets("Svodnaya")
        Do Until .Cells(r, "C").Value <> "a"
            r = r + 1
        Loop
        frmla = .Cells(r, "C").Formula
    End With
    'Mid(frmla, 2, Len(frmla) - 1) = "Raschet!K12" => "=OFFSET("Raschet!K12",0,1,1,1)"
    prmtr = Evaluate("Offset(" & Mid(frmla, 2, Len(frmla) - 1) & ", 0, 1, 1, 1)")
    MsgBox prmtr
End Sub

Option Explicit

Sub abc()
    Dim txt$, i&, r&, arr
    r = 2
    arr = Array("!", "@", "#", "$", "%", "^", "&", "*", "(", ")", "_", "-", "+", "=", "\", "/", "|", "?", "<", ">", _
                "~", "`", ",", ".", ":", ";", """", "'", "{", "[", "}", "]") '=> ??? eto dlya sluchaya takikh fraz kak 'Triol' i '/TRIOL/'
    Do Until Trim(Cells(r, "A").Value) = ""
        txt = Application.Trim(Cells(r, "B").Text)
        For i = 0 To UBound(arr)
            txt = Replace(txt, arr(i), "", 1, -1, 1)
        Next
        Cells(r, "C").Value = abc_xyz(txt)
        r = r + 1
    Loop
End Sub

Function abc_xyz(txt$)
    Dim rslt$, tmp$, ar, pos
    ar = Split(txt, " ", -1, 1)
    Do While UBound(ar) > -1
        tmp = ar(0)
        ar(0) = ""
        pos = Application.Match(tmp, ar, 0)
        If Not IsError(pos) Then
            rslt = IIf(rslt = "", tmp, rslt & "; " & tmp) '<=zdes' vy mozhete izmenit' razdelitel' pri neobkhodimosti
            Do While Not IsError(pos)
                ar(pos - 1) = ""
                pos = Application.Match(tmp, ar, 0)
            Loop
        End If
        ar = Split(Application.Trim(Join(ar, " ")), " ", -1, 1)
    Loop
    abc_xyz = rslt
End Function

Sub abc_xyz()
    Range("C4").Formula = "=TRUNC(C1,36)" ' => ??? 'ОТБР' ???
    Range("D4").Formula = "=TRUNC(D1,36)" ' => ??? 'ОТБР' ???
    Range("E4").Formula = "=IF(ISBLANK(D4),""ОШИБКА"",C4-D4)"
    Range("E5").Formula = "=C4-D4"
    Range("G4").Formula = "=C4=D4"
    Range("E5,G4").NumberFormat = "General"
End Sub

    rplc = Array(Chr(10), "<*b*>", "[*spoiler*]", "[*i*]")
    rplcmnt = "<p>" ' Array("<p>", "<p>", "<p>", "<p>")
    '...
        .Replace What:=rplc(i), Replacement:=rplcmnt
    '...

Sub Re_Move_Carrie_Age()
    Dim i%, xTitleId$, rplc, rplcmnt, workRng
    
    xTitleId = "Title"
    
    rplc = Array(Chr(10), "<*b*>", "[*spoiler*]", "[*i*]")
    rplcmnt = Array("<p>", "<p>", "<p>", "<p>")
    
    On Error Resume Next
        workRng = Application.InputBox("Range", xTitleId, Selection.Address, Type:=8).Address
        If workRng = Empty Then Exit Sub
    On Error GoTo 0
    
    With Range(workRng)
        For i = 0 To UBound(rplc)
            .Replace What:=rplc(i), Replacement:=rplcmnt(i), LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
        Next
        
        .Value = Application.Trim(.Value)
        .Value = Application.Clean(.Value) ' ???
    End With
End Sub

Option Explicit

Const pth$ = "C:\Program Files\Microsoft Office\OfficeXY\OUTLOOK.EXE"
Const strpath$ = "C:\Temp\AgentExcel.txt"

Sub para_ersatz_surrogat()
    Dim prmtr: prmtr = "Parametr iz Excel z " & Now
    '...
    Dim nmbr As Byte: nmbr = FreeFile(0)
    Open strpath For Output Access Write Lock Write As #nmbr
    Print #nmbr, prmtr
    Close #nmbr
    '
    Dim x: x = Shell(pth, vbNormalFocus)
End Sub

Option Explicit

Const strpath$ = "C:\Temp\AgentExcel.txt"

Private Sub Application_Startup()
    If Dir(strpath, vbNormal) = "" Then Exit Sub
    Dim prmtr$, nmbr As Byte: nmbr = FreeFile(0)
    Open strpath For Input Access Read Lock Read As #nmbr
    Line Input #nmbr, prmtr
    Close #nmbr
    Kill strpath
    Call Mak1(prmtr)
End Sub

Public Sub Mak1(Optional prmtr = "Net parametra iz Excel")
    MsgBox prmtr
End Sub

Private Sub Application_Startup()
    Call makro1
End Sub

Public Sub makro1()
    MsgBox "1"
End Sub

Sub abc_xyz()
    Dim x
    x = Shell("C:\Program Files\Microsoft Office\OfficeXY\OUTLOOK.EXE", vbNormalFocus)
End Sub

1. Set prom = Workbooks.Open("C:\Users\Gumin-AA\Desktop\sever.xlsx")
2. Set svod = Workbooks.Open("C:\Users\Gumin-AA\Desktop\ugeas.xlsm")
3. Set reestr = svod.Sheets("jenk")
4. Set zakl = prom.Sheets("Лист1")
5. Set otkl = prom.Sheets("Лист3")
 
6. lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

Option Explicit

Sub Tam_i_naoborot()
    Dim ctrl As Object
    
    '...
    For Each ctrl In ActiveSheet.OLEObjects
        If TypeOf ctrl.Object Is ToggleButton Then ctrl.Object.Enabled = Not ctrl.Object.Enabled
    Next
    '...
End Sub

Private Sub Worksheet_Calculate()
    Call abc_xyz
End Sub

Sub abc_xyz()
    With ActiveSheet
        If .AutoFilterMode Then
            Range("A1").CurrentRegion.Interior.Color = xlNone
            If .AutoFilter.FilterMode Then
                Dim i%, fltr
                For Each fltr In .AutoFilter.Filters
                    i = i + 1
                    If fltr.On Then Range("A1").CurrentRegion.Columns(i).Interior.Color = RGB(87, 240, 26)
                Next
            End If
        Else
            Range("A1").CurrentRegion.Interior.Color = xlNone
        End If
    End With
End Sub

Option Explicit

Sub abc_xyz()
    Dim rws&, tbl()
    Range("M1").CurrentRegion.ClearContents
    rws = Cells(Rows.Count, "A").End(xlUp).Row
    tbl = Application.Index(Range("A1:K11"), Application.Evaluate("Row(1:" & rws & ")"), Array(2, 4, 7))
    Range("M1").Resize(UBound(tbl), 3) = tbl
End Sub

Sub Data_type_Data()
    ' 'TypeName' provides information about a variable
    [K2] = TypeName([B2]) '=> 'Range' => object subtype
    [K3] = TypeName([G2]) '=> 'Range' => object subtype
    
    ' 'VarType' indicates the subtype of the variable
    [L2] = VarType([B2]) '=> '8' => 'String'
    [L3] = VarType([G2]) '=> '8' => 'String'
    
End Sub