Matti70 (tsbK230316), 04/07/2023 19:13:Allego il file con la colonna "C" filtrata dal valore più piccolo al valore più grande
Sub Estrai() Dim riga As Integer Dim cel As Range riga = 4 Application.ScreenUpdating = False For Each cel In Range("B1:B600") If cel.Offset(0, 1).Value < 7 Then Cells(riga, 5).Value = cel.Value Cells(riga, 6).Value = cel.Offset(0, 1).Value riga = riga + 1 End If Next cel ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Add2 Key:=Range("F4:F100" _ ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Foglio1").Sort .SetRange Range("E4:F100") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Application.ScreenUpdating = True End Sub