Sub Macro1()
With Application
     .ScreenUpdating = False
     .Calculation = xlManual

     Range("X2").Select
    Selection.FormulaArray = _
        "=IF(MAX(IF(MAX(($A:$A=$A2)*$W:$W)=($A:$A=$A2)*$W:$W,$P:$P,0))=$P2,MAX(IF(MAX(($A:$A=$A2)*$W:$W)=($A:$A=$A2)*$W:$W,$P:$P,0)),"""")"
  Range("X2").Select
    Call DownGo
     .Calculation = xlAutomatic
     .ScreenUpdating = True
     End With
End Sub

Этот код взял из примеров данного сайта.

Private Sub DownGo()
    Dim rng As Range, n As Long
    Set rng = ActiveCell.Offset(0, -1).CurrentRegion
    If rng.Cells.Count > 1 Then
        n = rng.Cells(1).Row + rng.Rows.Count - ActiveCell.Row
        ActiveCell.AutoFill Destination:=ActiveCell.Resize(n, 1), Type:=xlFillValues
    End If
End Sub

Private Sub Check_dup_Pcs()
 Sheets("1").Select
    Columns("c:c").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("c2").Select
    ActiveCell.FormulaR1C1 = "Check duplicated Pcs"
     Range("c3").Select
       Sheets("Fr").Range("c3").Copy Sheets("1").Range("c3")
  Range("c3").Select
    Application.Run "SmartFillDown"
   Range("a1").Select
 End Sub

Sub all()
Call tes
Call repl
Call Check_dup_Pcs
Call remove_nonB2C

Sub save_report()
 
wbName = ActiveWorkbook.Name
dirWB = CurDir
wbName2 = Format(Now, "dd.mm hh.nn") & " " & wbName & ".xlsx"
    Workbooks.Add 1
    ActiveWorkbook.SaveAs Filename:=dirWB & "\" & wbName2
 
    Windows(wbName).Activate
For Each sh In ActiveWorkbook.Sheets
'sh.Activate
If sh.Range("d2") = "Тариф" Then
    sh.Copy After:=Workbooks(wbName2).Sheets(Workbooks(wbName2).Sheets.Count)
  ActiveWorkbook.Save
    ActiveWindow.Close
    MsgBox "Отчет создан, проверьте рабочий стол!", , "Статус отчета!"
End If
Next
 

End Sub

Sub SendSheet_1()
ThisWorkbook.Sheets("test").Copy
 With ActiveWorkbook
        .SendMail Recipients:="test@test.com", Subject:="test_1"
     .Close SaveChanges:=False
    End With
End Sub