Работа с автофильтром ч/з VBA

[Сорокин]

Код работает у меня на 3 фамилиях нормально, а когда я сделал их на 50 то он говорит мне что процедура слишком большая.
Думаю что надо написать процедуру и сделать доступ к автофильтру не через criterial:="фамилия1", а через индекс фамилий(массив) и присваивать значения автофильтру,
как это сделать фиг его знает все перерыл, примеров програмного кода работы с фильтром пока не нашел, если подскажите что делать буду весьма признателен. Да начиная со второй записи формулы расчета одинаковы, меняются лиш значения переменных на основе знач последн строки записи фамилии. как описать в процедуре это не знаю...

Вот код:
Sub Макрос1()
Dim fill_data(6)
fill_data(0) = "" - занулено специально
fill_data(1) = "Присутствие на работе, мин:" расчетная строка, складыв. время в зависимости от К строк с данной фамилией
fill_data(2) = "Переналадка, мин:" - то же
fill_data(3) = "Ремонт, мин:"то же
fill_data(4) = "Простой, мин:"то же
fill_data(5) = "Хозработы, мин:"то же
fill_data(6) = "Оплачиваемое время, мин:"то же

Cells(3, 4).Select
Selection.AutoFilter Field:=4, Criteria1:="Айгузин Р. А." '- применяем фильтр
last_row = Cells(65536, 4).End(xlUp).Row '- ищем последнюю строку по данной фамилии
Cells(last_row, 4).Select '- выделяем
Rows("3:3").Select
Selection.AutoFilter '- убираем фильтр
Cells(last_row + 1, 4).Select '- вот № строки к которой добавл пустые
lr = last_row + 1 № строки к котор добавл пустые строки
Rows(lr).Select '
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
For i_ins = 1 To 6 Step 1
' Rows(lr + i_ins).Select '- ПОПЫТКА ВСТАВИТЬ ДОБАВЛЕНИЕ СТРОК В ЦИКЛ чтобы не писать Selection.Insert Shift:=xlDown НЕ ПОЛУЧИЛОСЬ
Cells(last_row + i_ins, 4).Value = "Айгузин Р. А." '- добавляем ФИО1 в добавл пустые строки
Next i_ins

For j = 1 To 6
k1 = last_row + j
Range(Cells(k1, 5), Cells(k1, 17)).SelectCells(k1, 5).Value = fill_data(j) - заполнение пустых строк рядом с фамилией
Next j

lst_r1 = last_row - 1 координаты для ячейки, подлеж. суммированию
lst_r2 = last_row - (last_row - 1) тоже самое

Cells(last_row + 1, 18).Select
ActiveCell.FormulaR1C1 = "=Sum(R[-" & (last_row - 3) & "]C10:R[-" & (last_row - (last_row - 1)) & "]C10)" - формула
Cells(last_row + 6, 18).Select
ActiveCell.FormulaR1C1 = "=Sum(R[-" & (last_row + 2) & "]C19:R[-6]C19)-R[-4]C-R[-3]C-R[-2]C-R[-1]C" - формула

'- ОБРАБОТКА 2-Й ЗАПИСИ даллее обработка 2-й фамилии

Cells(3, 4).Select
Selection.AutoFilter Field:=4, Criteria1:="Белослудцев А. В." '- применяем фильтр
last_row2 = Cells(65536, 4).End(xlUp).Row '- ищем последнюю строку по данной фамилии
'MsgBox last_row2
Cells(last_row2, 4).Select '- выделяем
' MsgBox last_row2 ' - проверим № строки
Cells(3, 4).Select
Selection.AutoFilter '- убираем фильтр
lr2 = last_row2 + 1 ' - строка, где добавляются пустые строки
Rows(lr2).Select '- вот она догожданная координатка
'MsgBox ("выделенная строка № ") & lr2
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку

For i_ins = 1 To 6 Step 1
Cells(last_row2 + i_ins, 4).Value = "Белослудцев А. В."
Next i_ins

For j = 1 To 6
k1 = last_row2 + j
Range(Cells(k1, 5), Cells(k1, 17)).Select
Cells(k1, 5).Value = fill_data(j)
Next j

lst_r21 = last_row2 - (last_row + 6) ' координаты начала второго массива
lst_r22 = last_row2 - (last_row2 - 1) ' ок координаты конца второго массива

Cells(last_row2 + 1, 18).Select
ActiveCell.FormulaR1C1 = "=Sum(R[-" & (lst_r21) & "]C10:R[-" & (lst_r22) & "]C10)"
Cells(last_row2 + 6, 18).Select
ActiveCell.FormulaR1C1 = "=Sum(R[-" & (last_row2 - (last_row + 1)) & "]C19:R[-6]C19)-R[-4]C-R[-3]C-R[-2]C-R[-1]C"

'- ОБРАБОТКА 3-Й ЗАПИСИ

Cells(3, 4).Select
Selection.AutoFilter Field:=4, Criteria1:="Блюденов А. В." '- применяем фильтр
last_row3 = Cells(65536, 4).End(xlUp).Row '- ищем последнюю строку по данной фамилии
'MsgBox last_row2
Cells(last_row3, 4).Select '- выделяем
' MsgBox last_row2 ' - проверим № строки
Cells(3, 4).Select
Selection.AutoFilter '- убираем фильтр
lr3 = last_row3 + 1 ' - строка, где добавляются пустые строки
Rows(lr3).Select '- вот она догожданная координатка
'MsgBox ("выделенная строка № ") & lr2
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку
Selection.Insert Shift:=xlDown '- добавляем строку

For i_ins = 1 To 6 Step 1
Cells(last_row3 + i_ins, 4).Value = "Блюденов А. В."
Next i_ins

For j = 1 To 6
k1 = last_row3 + j
Range(Cells(k1, 5), Cells(k1, 17)).Select Cells(k1, 5).Value = fill_data(j)
Next j

lst_r31 = last_row3 - (last_row2 + 6) ' координаты начала третьего массива
lst_r32 = last_row3 - (last_row3 - 1) ' ок координаты конца третьего массива

Cells(last_row3 + 1, 18).Select
ActiveCell.FormulaR1C1 = "=Sum(R[-" & (lst_r31) & "]C10:R[-" & (lst_r32) & "]C10)"
Cells(last_row3 + 6, 18).Select
ActiveCell.FormulaR1C1 = "=Sum(R[-" & (last_row3 - (last_row2 + 1)) & "]C19:R[-6]C19)--R
хотелось упростить сей код

[Naeel Maqsudov]

1. При публикации кода используйте теги [ code ] .... [ / code]