Помогите сделать сложную выборку с помощью макросов в Excel

[fsf]

Доброго вечера суток (по Киеву))
Учусь заочно, через неделю сессия. Вот никак не могу сделать выборку с помощью макросов VBA в Excel...
Смысл задачи таков: написать макрос для выборки стадионов, построенных не раньше некоторого года и при этом их вместимость находится в определенном диапазоне. Границы диапазона и год вводятся с клавиатуры...
Таблица прилагается ниже.
Заранее спасибо за помощь!

[staniiislav]

Плохо что в примере даже попытки не обнаружено решение Вашей задачи
Попробуйте так:

Option Explicit

Sub Stadion()
    Dim arr(), i&, s_1&, s_2&, s_3&, lsRow&, n&, j&, aSh As Worksheet
    Set aSh = ActiveSheet
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    s_1 = Application.InputBox(Prompt:="Введите год, стадиона построенного не раньше...", Title:="Год", Type:=1)
    If s_1 = 0 Then GoTo Cansel_InputBox
    s_2 = Application.InputBox(Prompt:="Вместимость от (число)...", Title:="Вместимость", Type:=1)
    If s_2 = 0 Then GoTo Cansel_InputBox
    s_3 = Application.InputBox(Prompt:="Вместимость до (число)...", Title:="Вместимость", Type:=1)
    If s_3 = 0 Then GoTo Cansel_InputBox
    
    With aSh.UsedRange
        lsRow = .Row + .Rows.Count - 1
    End With
    
    n = 1
    
    arr = aSh.Range("A1:F" & lsRow).Value
    For i = 2 To UBound(arr)
        If arr(i, 3) >= s_1 Then
            If arr(i, 5) >= s_2 Then
                If arr(i, 5) <= s_3 Then
                    n = n + 1
                    For j = 1 To UBound(arr, 2)
                        arr(n, j) = arr(i, j)
                    Next j
                End If
            End If
        End If
    Next i
    
    If n > 1 Then
        Worksheets.Add(After:=Worksheets(Sheets.Count)).Name = "Готово" & Fix(1000 * Rnd)
        Range("A1").Resize(n, UBound(arr, 2)) = arr
        Range("A1:F" & n).Borders.LineStyle = xlContinuous
        Range("A1:F1").Font.Bold = True
        Columns("A:F").EntireColumn.AutoFit
    End If
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    Exit Sub

Cansel_InputBox:
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub