Выборка в диапазоне значения по заданному промежутку и перенести на другой лист excel vba

[IgorGO]

а вот как раз надо непроще а детально, не можете словами - на конкретном примере:
вот границы,
вот десяток строк данных,
вот то из нх, что попало в результаты

[ac1-caesar]

к примеру промежуток задан от -20 до 30:
на листе main в первой строке
в колонке "TASK NUMBER" - 278211-L505-1
в колонке "DESCRIPTION" - CONTROL UNIT-SLAT
в колонке "DY" - (-18)
в колонке "FH" - (28)
в колонке "FC" - (123)

в соответствии с заданным промежутком эта строка попадает под наш выбор так как минимальное значение в просматриваемом диапазоне -18.

Теперь на листе results эта строка должна отобразиться так:
в первой колонке - 278211-L505-1
во второй - (18)
в третьей - ""
в четвертой - ""

и так по всей таблице

а это попадает
в колонке "DY" - (28)
в колонке "FH" - (-18)
в колонке "FC" - (123)
в тот же диапазон?

Да попадает, так как минимальное значение в этой строке -18.

Промежуток задается для минимального значения в строке.

а это попадает
в колонке "DY" - (28)
в колонке "FH" - (-18)
в колонке "FC" - (123)
в тот же диапазон?

Да попадает,
а как отобразиться?

в первой колонке - соответствующий TASK NUMBER
во второй - ""
в третьей - (-18)
в четвертой - ""

[ac1-caesar]

а вот как раз надо непроще а детально, не можете словами - на конкретном примере:
вот границы,
вот десяток строк данных,
вот то из нх, что попало в результаты

файл с примером в скрепке. На листе main данные, промежуток выбираемых значений от -20 до 30, на листе results что должно быть.

[IgorGO]

Private Sub CommandButtonPrepare_Click()
  Dim r As Long, c As Long, rc As Long, i As Long, j As Long, ar(), m1 As Double, m2 As Double, m As Double, s As String
  With Sheets("main")
    m1 = Val(.TextBoxFrom):  m2 = Val(.TextBoxTo)
    s = "=SumProduct((" & .Range("Таблица1[[DY]:[FC]]").Address & ">=" & .TextBoxFrom & ")*(" & .Range("Таблица1[[DY]:[FC]]").Address & "<=" & .TextBoxTo & "))"
    i = Application.Evaluate(s):  ReDim ar(1 To i, 1 To 4):   i = 0
    r = .Range("Таблица1[[DY]:[FC]]").Row:  c = .Range("Таблица1[[DY]:[FC]]").Column:
    For r = r To r + .Range("Таблица1[[DY]:[FC]]").Rows.Count - 1
      m = Application.Min(Cells(r, c).Resize(1, 3))
      If (m - m1) * (m - m2) <= 0 Then
        i = i + 1: ar(i, 1) = Cells(r, 1)
        For j = 1 To 3
          If Cells(r, c + j - 1) = m Then ar(i, j + 1) = m
        Next
      End If
    Next
  End With
  Worksheets.Add:   ActiveSheet.Cells(1, 1).Resize(UBound(ar), 4).Value = ar
End Sub

а пример Ваш не правильный строка с 21 не попадает в результаты, потому что мин. число в этой строке -49, меньше чем -20.

[ac1-caesar]

IgorGO, спасибо большое.
Как всегда изящное решение!
Извиняюсь за неверно сформулированный вопрос.

[ac1-caesar]

Уважаемый IgorGO, пожалуйста посмотрите что не так.
Книга с кодом, заданным промежутком и листом для результатов называется Planned.
Книга просматриваемого массива называется Task_Status.
Вроде прописал путь, указал имя листа для просмотра, указал имя листа для результатов.
Выдает ошибку Subscript out of range на строке ar(i, 1) = Cells(r, 1)

Sub Prepare()

Application.ScreenUpdating = False

  Dim r, c, rc, i, j As Long
  Dim ar(), m1, m2, m As Double
  Dim s As String
  Dim WbMP As Workbook
  
    m1 = Val(ThisWorkbook.Sheets("Main").Cells(2, 2))
    m2 = Val(ThisWorkbook.Sheets("Main").Cells(2, 4))
    
  Set WbMP = Workbooks.Open("C:\Users\A. Shvechkov\Desktop\Task_Status.xlsm") 'задайте свой путь размещения
  
  With WbMP.Sheets("Task_Status")

    s = "=SumProduct((" & .Range("Таблица9[[REMAINING DY 0157]:[REMAINING FC 0157]]").Address & ">=" & m1 & ")*(" & .Range("Таблица9[[REMAINING DY 0157]:[REMAINING FC 0157]]").Address & "<=" & m2 & "))"
    i = Application.Evaluate(s)
    ReDim ar(1 To i, 1 To 4)
    i = 4
    r = .Range("Таблица9[[REMAINING DY 0157]:[REMAINING FC 0157]]").Row
    c = .Range("Таблица9[[REMAINING DY 0157]:[REMAINING FC 0157]]").Column
    For r = r To r + .Range("Таблица9[[REMAINING DY 0157]:[REMAINING FC 0157]]").Rows.Count - 1
      m = Application.Min(Cells(r, c).Resize(1, 3))
      If (m - m1) * (m - m2) <= 0 Then
        i = i + 1
        ar(i, 1) = Cells(r, 1)
        For j = 1 To 3
          If Cells(r, c + j - 1) = m Then ar(i, j + 1) = m
        Next
      End If
    Next
  End With
WbMP.Close
  
  With ThisWorkbook.Sheets("AMP")
  .Cells(1, 1).Resize(UBound(ar), 4).Value = ar
  End With

Application.ScreenUpdating = True

End Sub

[ac1-caesar]

Файлы прилепил.

[ac1-caesar]

А то что то я в этой высшей математике разобраться не могу
Использование Resize, ReDim, UBound разрушили мою маломальскую уверенность в понимании vba.

[IgorGO]

    i = 0
    r = .Range("Таблица9[[REMAINING DY 0157]:[REMAINING FC 0157]]").Row
    c = .Range("Таблица9[[REMAINING DY 0157]:[REMAINING FC 0157]]").Column
    For r = r To r + .Range("Таблица9[[REMAINING DY 0157]:[REMAINING FC 0157]]").Rows.Count - 1
      m = Application.Min(Cells(r, c).Resize(1, 3))
      If WorksheetFunction.Count(Cells(r, c).Resize(1, 3)) = 0 Then m = 1 + Abs(m1) + Abs(m2)
      If (m - m1) * (m - m2) <= 0 Then
        i = i + 1
        ar(i, 1) = .Cells(r, 3)
        For j = 1 To 3
          If .Cells(r, c + j - 1) = m Then ar(i, j + 1) = m
        Next
      End If
    Next

тут нет высшей математики - одна арифметика
1. i = 0 планировалось, что начальное значение i = 0, а не 4

2. оказалось в данных полно строк где все 3 рассматриваемые ячейки пусты, тогда m = Application.Min(Cells(r, c).Resize(1, 3)) = 0, 0 - входит в диапазон, и записывается в результирующий массив
эти варианты надо присечь

      If WorksheetFunction.Count(Cells(r, c).Resize(1, 3)) = 0 Then m = 1 + Abs(m1) + Abs(m2)

3 и номер задачи у Вас в 3-й колонке, а не в 1-й как было показано вначале

        ar(i, 1) = .Cells(r, 3)

успехов в труде и зарплате!!!

[ac1-caesar]

Спасибо, за разъяснения. И Вам успехов во всем!!!