Selección de celdas que cumplen una condición

Gracias por contestar Luis, lo que asumes es correcto. Ya he conseguido hacer un código que cumple con lo que quiero excepto que tarda 8 min en darme las soluciones, pues tiene que recorrer del orden de 30000 filas. A ver si pudieras ayudarme a mejorarlo

Esto ha sido lo que he hecho:

Sub IfMaxCondition()
    
Dim rpm As String
Dim finalrow As Integer
Dim i As Integer
Dim max As Double

Sheets("Vibration1").Range("P1:Z50000").ClearContents
finalrow = Sheets("Vibration1").Range("A50000").End(xlUp).Row
'655
For i = 2 To finalrow
    If Cells(i, 2) < 656 And Cells(i, 2) > 654 Then
        Cells(i, 8).Copy
        Range("P10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    End If
Next i
'690
For i = 2 To finalrow
    If Cells(i, 2) < 693 And Cells(i, 2) > 687 Then
        Cells(i, 8).Copy
        Range("R10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    End If
   Next i
'730
   For i = 2 To finalrow
    If Cells(i, 2) < 733 And Cells(i, 2) > 727 Then
        Cells(i, 8).Copy
        Range("T10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    End If
   Next i
'842
   For i = 2 To finalrow
    If Cells(i, 2) < 845 And Cells(i, 2) > 839 Then
        Cells(i, 8).Copy
        Range("V10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    End If
   Next i
'860
   For i = 2 To finalrow
    If Cells(i, 2) < 863 And Cells(i, 2) > 857 Then
        Cells(i, 8).Copy
        Range("X10000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    End If
   Next i

Range("P2").Select

max = Application.WorksheetFunction.max(Range("P2:P10000"))
Range("Q2") = max
max = Application.WorksheetFunction.max(Range("R2:R10000"))
Range("S2") = max
max = Application.WorksheetFunction.max(Range("T2:T10000"))
Range("U2") = max
max = Application.WorksheetFunction.max(Range("V2:V10000"))
Range("W2") = max
max = Application.WorksheetFunction.max(Range("X2:X10000"))
Range("Y2") = max

Hoja2.Select

Range("A1") = Sheets("Vibration1").Range("Q2")
Range("B1") = Sheets("Vibration1").Range("S2")
Range("C1") = Sheets("Vibration1").Range("U2")
Range("D1") = Sheets("Vibration1").Range("W2")
Range("E1") = Sheets("Vibration1").Range("Y2")


End Sub


Editado por jmpm - 29/Octubre/2018 a las 15:50

Prueba con una fórmula matricial:

   {=MAX(($A$2:$A$30>=100)*($A$2:$A$30<=200)*$D$2:$D$30)}

Las llaves no debes escribirlas, como fórmula matricial que es, debes entrarla con Ctrl +Mayúscula + Intro (no con solo Intro).

Ojalá me hubiera funcionado porque habría sido mucho más rápido, pero me aparece #VALOR en la celda. Gracias de todos modos