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
Больше недели бьюсь с сводной таблицей. Много чего получилось победить самому что-то подсказывали на форуме, но обновление сводной никак не поддается. Пробовал подставлять различные варианты которые находил, но либо макрос работает некорректно либо ошибки. Есть вариант записать макрос через макрекордер с обновлением, но в таком случае при удалении строк область для обновления уменьшается на количество удаленных срок.
Единственное что получилось это жестко привязать обновление к файлу, но это не вариант. накидаете ссылок или помогите советом.
Макрос удаляет лишние строки, обновляет столбцы с формулами, полученный результат должен обновится в своде и после исходные данные копируются на следующий лист