MaxSwitchValCY/PY = 
VAR MaxNum = CALCULATE(
    MAXX(
        VALUES(Elements[Element ENG]),
        [SwitchValCY/PY]
    ),
    ALLSELECTED(Elements[Element ENG])
)
VAR MaxElement = FILTER(
    ALL(Elements[Element ENG]),
    [SwitchValCY/PY] = MaxNum
)
VAR Res = CALCULATE(
    [SwitchValCY/PY],
    KEEPFILTERS(MaxElement)
)
RETURN Res

MaxSwitchVal (metric) = 
VAR MaxSwitchVal = CALCULATE(
        [SwitchValCY/PY],
        GROUPBY(Elements,Elements[Element ENG]
        )
    )
VAR NewTable = SUMMARIZE(
        'Scores by apparatuses (transp)', Elements[Element ENG],
        "CalcCul", MaxSwitchVal
    )
RETURN MAXX(
    NewTable,
    MaxSwitchVal
)

Dim LastActiveSheet As Worksheet, lastrow As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set LastActiveSheet = ActiveSheet
lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With ActiveSheet
For i = 2 To lastrow
    .Cells(i, 12).Copy
    .Cells(i, 13).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
LastActiveSheet.Activate
Next i
End With
End Sub

    .Cells(i, 12).Copy Destination:=Hyperlinks(1).address

Sub woho()
Dim a As Integer, b As Integer, c As Integer, r As Integer

For r = 1 To 2
For a = 1 To 4
For b = 1 To 4
For c = 1 To 4
Cells(r, 9) = Cells(a, 1) & " " & Cells(b, 2) & " " & Cells(c, 3)
r = r + 1
Next c
Next b
Next a


Next r

End Sub

=ПРАВСИМВ(ячейка с текстом;кол-во знаков)

Sub Макрос1()

    Dim sheet As Worksheet
    LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Coun
    
    With ActiveWorkbook

    For Each sheet In ActiveWorkbook.Worksheets 'для всех листов в книге
  
    For r = LastRow To 2 Step -1 
        If Application.CountA(Rows(r)) = 1 Then Rows(r).Delete
    Next r


    Next
    End With  
    
End Sub

Sub Макрос1()
Application.ScreenUpdating = False
    Columns("M:M").Select
    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("M1").Select
    Selection.AutoFilter
    ActiveSheet.Range("M:M").AutoFilter Field:=1, Criteria1:=RGB(255, _
        199, 206), Operator:=xlFilterCellColor
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("N1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Range("M:M").AutoFilter Field:=1
    Columns("M:M").Select
    Selection.FormatConditions.Delete
    Selection.AutoFilter
End Sub

    Dim sheet As Worksheet
    Dim cell As Range
    With ActiveWorkbook
   
    Worksheets(8).Select
    Rows(70).Select
    Selection.ClearContents

    For Each sheet In ActiveWorkbook.Worksheets
         Set cell = Worksheets(8).Cells(70, sheet.Index + 2)
         .Worksheets(3).Hyperlinks.Add Anchor:=cell, Address:="", _
         SubAddress:="'" & sheet.Name & "'" & "!A1"
         cell.Formula = sheet.Name
    Next
    End With
    
    ActiveSheet.Calculate

For i = 9 To Sheets.Count
    Worksheets(i).Activate
    If Cells(1, 2) = "Выводить" Then
        Worksheets(i).Select
    End If
Next
Selection.Name = sheet
    
    With ActiveWorkbook
   
    Worksheets(8).Select
    Rows(70).Select
    Selection.ClearContents

    For Each sheet In ActiveWorkbook.Worksheets
         Set cell = Worksheets(8).Cells(70, sheet.Index + 2)
         .Worksheets(3).Hyperlinks.Add Anchor:=cell, Address:="", _
         SubAddress:="'" & sheet.Name & "'" & "!A1"
         cell.Formula = sheet.Name
    Next
    End With
    
    ActiveSheet.Calculate