После использования расширенного фильтра не работает функция subtotal - VBA

Формулировка задачи:

Добрый день! Никак не могу разобраться с суммированием динамического диапазона строк в столбце после применения фильтра. Есть таблица на Листе1, куда через форму вводятся данные. Затем таблица копируется на Лист2, где я задала расширенный фильтр, он работает нормально. Данные в таблице могут изменяться (строки добавляться, удаляться). В 9 столбце (I) нужно произвести суммирование видимых строк, думаю использовать функцию subtotal. Но никаким образом она не хочет работать. Пыталась сделать перебором с циклом заполненных строк и выводом результата функции в последующую после последней ячейки. Не работает. Помогите пожалуйста! Файл программы достаточно большой, выкладывать думаю, не стоит. Вот код:

Private Sub Worksheet_Activate()
Sheets(1).UsedRange.Copy Sheets(2).Cells(7, 1) 'копирование таблицы с листа1 при активации листа2.
'С 7 строки для расширенного фильтра
Sheets(2).Range("I7").End(xlDown).Clear
On Error Resume Next
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:I5")) Is Nothing Then 'диапазон дополнит таблицы (таблицы условий)
        On Error Resume Next
        ActiveSheet.ShowAllData 'очистка данных от предущей фильтрации
        Range("A7").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion
        'Range("A7")- первая ячейка диапазона исходных данных.Range("A1")- начало диапазона условий
    End If
    If AdvancedFilter = True Then
           Dim ra As Range
      Dim iRow As Long 'Хранит номер текущей строки
   Const y = 7 - количество строк шапки
   Dim dCellValues() As Range 'Массив для хранения значений ячеек
   iRow = y + 1
   ReDim dCellValues(1 To 10)
    'Цикл Do Until перебирает последовательно ячейки столбца I активного листа
   'и извлекает их значения в массив до тех пор, пока не встретится пустая ячейка
   Do Until IsEmpty(Cells(iRow, 9))
       'Проверяем, что массив dCellValues имеет достаточный размер
      'Если нет – увеличиваем размер массива на 10 при помощи ReDim
      If UBound(dCellValues) < iRow Then
         ReDim Preserve dCellValues(1 To iRow + 9)
      End If
      'Сохраняем значение текущей ячейки в массиве dCellValues
   dCellValues(iRow) = Cells(iRow, 9).Value
      iRow = iRow + 1
        Loop
 Set ra = ActiveSheet.Range("I7").End(xlDown).Offset(1, 0) 'выбор пустой ячейки, которая ниже непрерывного столбца
  ra.Select
      ra.Value = Application.WorksheetFunction.Subtotal (109, dCellValues(iRow))
   End If
 
  End Sub

Решение задачи: «После использования расширенного фильтра не работает функция subtotal»

textual
                            Листинг программы 
                        

                            Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Not Intersect(Target, [A2:I5]) Is Nothing Then
       'If FilterMode = True Then ShowAllData
       Application.EnableEvents = False
       [I:I].Replace "=SUBTOTAL(*", ""
       With [A7].CurrentRegion
            .AdvancedFilter xlFilterInPlace, [A1].CurrentRegion
            .Cells(.Rows.Count + 1, 9) = "=SUBTOTAL(9, " & .Columns(9).Address & ")"
       End With
       Application.EnableEvents = True
    End If
End Sub
                        