Нарезка данных - Макрос

[Наталья_А]

Добрый день
Прошу помочь разобраться с макросом. я в этом деле новичок.
Есть сводный отчёт по регионам, задача такова, что необходимо его ежедневно нарезать по признаку Регион.
Макрос прописан, но он почему то не нарезает по заданному фильтру (по региону), а вырезает только шапку и создает эту шапку на новые листы.
В итоге нужно что бы отчёт нарезал шапку и данные каждого региона на новый лист с сохранением группировки слева.
Прошу подсказать в чём ошибка
Файл с данными и макросом во вложении.

Код Выделить Развернуть

Sub RunThis()
    FiltTo "Харьков"
    FiltTo "Винница"
    FiltTo "Черкассы"
   
    End Sub

Sub FiltTo(sWhat As String)
    Dim lr As Long

    With Лист1
        lr = .Range("A4").End(xlDown).Row

        .Range("A6").AutoFilter
        With .Range("A6:Q" & lr)
            .AutoFilter 17, "=*" & sWhat & "*"
            .Copy
        End With
        '======================================
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Paste
        '======================================
        .Range("A6").AutoFilter
    End With
End Sub

[cheshiki1]

поиск последней заполненной так правильнее будет.

Код Выделить Развернуть

lr = .Cells(Rows.Count, 1).End(xlUp).Row
почему фильтр по 17 столбцу? его у вас нет.
П.С. Оформляйте код тэгами.

[Наталья_А]

поиск последней заполненной так правильнее будет.

Код Выделить Развернуть

lr = .Cells(Rows.Count, 1).End(xlUp).Row
почему фильтр по 17 столбцу? его у вас нет.
П.С. Оформляйте код тэгами.

Спасибо большое, всё получилось!