Макрос для выборки автомобилей,выпущенных не раньше определённого года

[negnaya111]

Помогите,пожалуйста,написать макрос.Никак не получается.
В таблице находятся ведомости об автомобилях:марка,серийный номер,регистрационный номер,цвет,количество дверей,год выпуска,цена.Необходимо написать макрос для выборки автомобилей определённого цвета,выпущенных не раньше определённого года.Необходимый цвет и год выпуска задаются с клавиатуры.Результат записать на новый рабочий лист.
Помогите,пожалуйста.

[Hugo121]

Ого!
Я пока читал, представил, как выглядит рабочий файл
Когда дочитал до "Необходимый цвет и год выпуска задаются с клавиатуры" - понял, что никакого рабочего файла нет... Переубедите меня

[negnaya111]

Я макрос создания таблицы с необходимыми данными написала.Написала так же чтобы вводилось окно запроса о вводе года выпуска.А вот выборка автомобилей,выпущенных не раньше введённого числа у меня не получается.

[Hugo121]

И где это всё?

[negnaya111]

Вот я прикрепила файл.

[Hugo121]

А цвет?
А куда отбирать?
Я бы делал на массивах - исходные данные берём в массив, когда выяснили цвет и год - перебираем массив и отбираем подходящие строки в другой созданный заранее под максимальный размер массив, его заполненную часть выгружаем.
Так будет быстрее. Но в этой учебной задаче можно просто пройтись циклом по строкам, или использовать фильтр, затем видимые строки скопировать (куда?)

Например, заготовка:

Sub tt()
    Sheets(1).AutoFilterMode = 0
    With Sheets(1).[A2].CurrentRegion
        .AutoFilter 4, "Серый", 1: .AutoFilter 6, ">1995", 1
        .SpecialCells(12).Copy Sheets(2).[A1]
    End With
    Sheets(1).AutoFilterMode = False
End Sub

[negnaya111]

Выдаёт ошибку Subscript out of range.

[Hugo121]

Subscript out of range - это потому, что не создали сперва второй лист.
Так можно автофильтром отобрать (версия 2, лист создаётся сам):

Sub tt()
    Dim sh As Worksheet
    Application.ScreenUpdating = False

    Set sh = ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count))
    Sheets("Лист1").AutoFilterMode = 0
    With Sheets("Лист1").[A2].CurrentRegion
        .AutoFilter 4, "Серый", 1: .AutoFilter 6, ">1995", 1
        .SpecialCells(12).Copy sh.[A1]
        sh.Cells.EntireColumn.AutoFit
    End With
    Sheets("Лист1").AutoFilterMode = False

    Application.ScreenUpdating = True
End Sub

Но что-то тут не получается красиво подстраховаться от того, что вдруг отберётся только шапка - тогда ведь незачем лист создавать.
А если делать перебором - то можно посчитать количество отобранных строк.

[negnaya111]

Оно то выводит на другой лист,но только шапку таблицы или нужно в макросе указать конкретный цвет и год.А если каждый раз вводить другой год выпуска,то тогда не получится.

[Hugo121]

Так получилось не копировать, если нечего:

Sub tt()
    Dim sh As Worksheet
    Application.ScreenUpdating = False

    Sheets("Лист1").AutoFilterMode = 0
    With Sheets("Лист1").[A2].CurrentRegion
        .AutoFilter 4, "Серый", 1: .AutoFilter 6, ">2000", 1
        If .SpecialCells(12).Rows.Count > 1 Then
            Set sh = ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count))
            .SpecialCells(12).Copy sh.[A1]
            sh.Cells.EntireColumn.AutoFit
        End If
    End With
    Sheets("Лист1").AutoFilterMode = False

    Application.ScreenUpdating = True
End Sub