Sorgula ve diğer sayfaya aktar

[asilsensin]

istenen sutunu var birde stok sutunu var
istenenin stok dan fazla olduğu satırları diğer sayfaya aktarmak istiyorum
örnek ektedir

 

[Orion1]

Dosyanız Ekte.

Sub aktar()
Dim i As Long, sat As Long
Sheets("A").Select
sat = 2
Application.ScreenUpdating = False
With Sheets("B")
.Range("A2:D65536").ClearContents
For i = 2 To Cells(65536, "A").End(xlUp).Row
    If Cells(i, "C").Value > Cells(i, "D").Value Then
        .Range("A" & sat & ":E" & sat).Value _
        = Range("A" & i & ":E" & i).Value
        sat = sat + 1
    End If
Next i
End With
Application.ScreenUpdating = True
Sheets("B").Select
MsgBox "Aktarma tamamlandı"
End Sub

 

[asilsensin]

çok teşekkürler sağolasın.

 

[degirman]

Bunu formülle yapmamız mümkün değil mi?