Option Explicit
 
Sub copyu()
    Dim oDic As Object, oFSO As Object
    Dim arrData(), arrSeparateItems(), arrTemp()
    Dim TempWb As Workbook
    Dim sFolderPath As String, sFullFileName As String
    Dim LastRow As Long, i As Long, n As Long, c As Long, r As Long
 
    If MsgBox(?????", vbQuestion + vbYesNo, "Разбивка") = vbNo Then Exit Sub
     
    
    sFolderPath = "https://mhpo365.sharepoint.com"
  
   
    If sFolderPath = vbNullString Then Exit Sub
    If Right(sFolderPath, 1) <> Application.PathSeparator Then sFolderPath = sFolderPath & Application.PathSeparator
           
    Application.ScreenUpdating = False
     
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oDic = CreateObject("Scripting.Dictionary")
     
    With ActiveSheet
        If .FilterMode = True Then .ShowAllData
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        arrData = .Range("A2:AB" & LastRow).Value
    End With
     
    For i = 1 To UBound(arrData)
        If Not oDic.Exists(arrData(i, 1)) Then oDic.Add arrData(i, 1), 0&
    Next i
    arrSeparateItems() = oDic.Keys
     
    For n = LBound(arrSeparateItems) To UBound(arrSeparateItems)
        ReDim arrTemp(1 To UBound(arrData), 1 To UBound(arrData, 2))
        r = 0
        For i = LBound(arrData) To UBound(arrData)
            If arrData(i, 1) = arrSeparateItems(n) Then
                r = r + 1
                For c = LBound(arrData, 2) To UBound(arrData, 2)
                    arrTemp(r, c) = arrData(i, c)
                Next c
            End If
        Next i
         
        Set TempWb = Workbooks.Add
        With TempWb.Worksheets(1)
            .Range("A1").Resize(1, UBound(arrData, 2)).Value = arrData
            .Range("A2").Resize(UBound(arrTemp), UBound(arrTemp, 2)).Value = arrTemp
            .Columns("A:Z").AutoFit
        End With
         
        sFullFileName = sFolderPath & arrSeparateItems(n) & ".xlsx"
        If oFSO.FileExists(sFullFileName) Then oFSO.Deletefile (sFullFileName)
        TempWb.SaveAs sFullFileName, FileFormat:=51 'XLSX
        TempWb.Close SaveChanges:=False
    Next n
     
    Application.ScreenUpdating = True
    MsgBox "???? " & sFolderPath, vbInformation
End Sub

=ЕСЛИ(ОКРУГЛ(F3;2)*100<30;"C";
ЕСЛИ(И(ОКРУГЛ(F3;2)*100>=31;ОКРУГЛ(F3;2)*100<=60);"B";
ЕСЛИ(И(ОКРУГЛ(F3;2)*100>=61;ОКРУГЛ(F3;2)*100<=100);"A";
)))

Measure = Calculate (sum ([колонка которую суммируем]);Filter([таблица в которой суммируешь];[поле в котором пишешь фильтр]))

Measure = calculate(sum('budget'[RISK]);filter('budget';'budget'[YEAR]="2019"))

=IF(COUNTIFS(Лист2!E:E;"Покупка";Лист2!D:D;Лист1!$C$1;Лист2!B:B;Лист1!A2)>=2; "YES"; "NO")

Private Sub Workbook_Open()
    Dim WshShell As Object
    Set WshShell = CreateObject("WScript.Shell")
    Dim strDesktop As String
    strDesktop = WshShell.SpecialFolders("Desktop")
    Dim oShellLink As Object
    Set oShellLink = WshShell.CreateShortcut(strDesktop & "\A.I.D.A.lnk")
    oShellLink.TargetPath = "https://apps.powerapps.com/"
    oShellLink.WindowStyle = 1

    oShellLink.IconLocation = "G:\"
    oShellLink.Description = "The best app in the world"
    oShellLink.WorkingDirectory = strDesktop
  
    oShellLink.Save
    Dim a As Integer
    a = MsgBox("Поздравляю, на вашем рабочем столе появился значек A.I.D.A" & vbNewLine & "Приятного использования!", 64)
UserForm1.Show
End Sub

Sub CreateDesktopShortcutWithIcon()
    
    Dim WshShell As Object
    Set WshShell = CreateObject("WScript.Shell")
    Dim strDesktop As String
    strDesktop = WshShell.SpecialFolders("Desktop")
    Dim oShellLink As Object
    Set oShellLink = WshShell.CreateShortcut(strDesktop & "\название.lnk")
    oShellLink.TargetPath = "ссылка"
    oShellLink.WindowStyle = 1
    
    oShellLink.IconLocation = "C:\__tmp\MIME\foo.ico"  '
    oShellLink.Description = "THE BEST OF THE BEST"
    oShellLink.WorkingDirectory = strDesktop
  
    oShellLink.Save
End Sub

=INDEX(Из!A:M;MATCH(В!A2;Из!A:A;0);MATCH(В!B2;Из!$1:$1;0))

=MID(D2;FIND(C2;D2)+LEN(C2);LEN(D2)-LEN(C2))

IF(RC[5]>=1,""уменьшение XXX на ""&TEXT(RC[5],0)&"" млн долл"","""")

=(SUMPRODUCT(O17:T33;(B17:B33=H2)*(O13:T13=I1)))