ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Макс!A1:F2000", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:=Worksheets("Макс").Range("I2"), TableName:="Сводная Таблица", DefaultVersion:=xlPivotTableVersion14
      Application.GoTo Worksheets("Макс").Range("I2")

Sub МАКС()
'
If Worksheets("Макс").PivotTables.Count > 0 Then
    Worksheets("Макс").PivotTables("Свод").TableRange2.Clear
End If
Dim ra As Range, delra As Range, ТекстДляПоиска As String
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    ТекстДляПоиска = "Комплекты"    ' удаляем строки с таким текстом
    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' если в строке найден искомый текст
        If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
    With ActiveSheet
    .Range("E3:F" & .Cells(.Rows.Count, "F").End(xlUp).Row).ClearContents
    .Range("E2:F2").AutoFill .Range("E2:F" & .Cells(.Rows.Count, "D").End(xlUp).Row)
   
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Макс!R1C4:R1048576C6", Version:=6).CreatePivotTable _
        TableDestination:="Макс!R2C9", TableName:="Сводная таблица", DefaultVersion:=6
    Sheets("Макс").Select
    Cells(2, 9).Select
With ActiveSheet.PivotTables("Сводная таблица").PivotFields("Вид тары")
        .Orientation = xlRowField
        .Position = 1
End With
    ActiveSheet.PivotTables("Сводная таблица").AddDataField ActiveSheet. _
    PivotTables("Сводная таблица").PivotFields("Количество"), _
    "Количество по полю Количество", xlCount
With ActiveSheet.PivotTables("Сводная таблица5").PivotFields( _
        "Количество по полю Количество")
        .Calculation = xlPercentOfTotal
        .NumberFormat = "0,00%"
End With
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(Calculation!R[8]C[-7],'Макс'!C[1]:C[2],2,0),0)"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A21"), Type:= _
        xlFillDefault
    ActiveCell.Range("A1:A21").Select
    Selection.Copy
    Sheets("Calculation").Select
            
End Sub

Sub Вместимость() 
' 
Dim ra As Range, delra As Range, ТекстДляПоиска As String 
Application.ScreenUpdating = False ' отключаем обновление экрана 

ТекстДляПоиска = "Комплекты" ' удаляем строки с таким текстом 

' перебираем все строки в используемом диапазоне листа 
For Each ra In ActiveSheet.UsedRange.Rows 
' если в строке найден искомый текст 
If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then 
' добавляем строку в диапазон для удаления 
If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra) 
End If 
Next 
' если подходящие строки найдены - удаляем их 
If Not delra Is Nothing Then delra.EntireRow.Delete 
With ActiveSheet 
.Range("E3:F" & .Cells(.Rows.Count, "F").End(xlUp).Row).ClearContents 
.Range("E2:F2").AutoFill .Range("E2:F" & .Cells(.Rows.Count, "D").End(xlUp).Row) 
Range("A1:F1000").Select 
Range("A2").Activate 
Sheets("Свод макс").Select 
Range("A1").Select 
ActiveSheet.PivotTables("Свод").ChangePivotCache ActiveWorkbook.PivotCaches. _ 
Create(SourceType:=xlDatabase, SourceData:= _ 
"C:\Users\User\Documents\Вместимость\2017\01\Вместимость 23-27.17\[Макрос.xlsm]Вместимость!R1C1:R1000C6" _ 
, Version:=xlPivotTableVersion15) 
Range("F12:F17").Select 
Selection.Copy 
Sheets("Calculation").Select 
End With