Nadam se da je ovo što si tražila. Kroz Inputbox zadaju se ulazni podaci i celija od koje se smestaju rezultati. Uslov je fiksiran u kodu, ali se uz sitne intervencije moze i on prezeti iz Inputbox-a, ili kao vrednost neke celije
Code:
Sub FilterList()
Dim rngSource As Range
Dim rngDest As Range
Const uslov As Double = "20" ' Ovde promeniti uslov
On Error Resume Next
Set rngSource = Application.InputBox("Selektuj listu za filtriranje:", "Ulazni podaci", Type:=8)
If (rngSource Is Nothing) = True Then Exit Sub
Set rngDest = Application.InputBox("Selektuj odredišnu celiju:", "Filrirani podaci", Type:=8)
If (rngDest Is Nothing) = True Then Exit Sub
' Prvi deo
rngDest.Value = "< " & uslov
r = 1
For Each c In rngSource
If c.Value < uslov Then
rngDest.Offset(RowOffset:=r).Value = c.Value
r = r + 1
End If
Next c
' Drugi deo
rngDest.Offset(RowOffset:=r).Value = ">= " & Str(uslov)
r = r + 1
For Each c In rngSource
If c.Value >= uslov Then
rngDest.Offset(RowOffset:=r).Value = c.Value
r = r + 1
End If
Next c
' Total
rngDest.Offset(RowOffset:=r).Value = "SVEGA"
rngDest.Offset(RowOffset:=r + 1).Formula = "=SUM( " & rngDest.Address & ":" & rngDest.Offset(r - 1).Address & ")"
rngDest.Offset(RowOffset:=r + 1).Font.Bold = True
End Sub
Nije to loše Rembrante, samo što ne bi dodao još malo boje?