satır aktarma

[Barons]

merhaba
ek'teki dosyada E sütununda değer 100 ve üstü ise komple o satırı arsive kaldırmak istiyorum.
Kaldırdıktan sonrada tekrar ST sayfasını A sütununa göre sıralatmam gerekiyor.
Yardımlar için şimdiden çok teşekkürler.

 

[fedeal]

dosyanız ekte,iyi çalışmalar.

Sub f()
g = Sheets("st").Range("A65536").End(xlUp).Row
For i = 2 To g
If (Sheets("st").Range("c" & i).Value >= Sheets("st").Range("b" & i).Value) Then
s = Sheets("arsiv").Range("A65536").End(xlUp).Row + 1
For k = 1 To 8
Sheets("arsiv").Cells(s, k).Value = Sheets("st").Cells(i, k).Value
Sheets("st").Cells(i, "a").Value = ""
Next
End If
Next
[a:a].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

 

[Orion1]

Dosyanız ekte.

Sub kaldir()
Dim sat As Long, i As Long
Sheets("ST").Select
Application.ScreenUpdating = False
sat = Sheets("arsiv").Cells(65536, "A").End(xlUp).Row + 1
For i = Cells(65536, "A").End(xlUp).Row To 2 Step -1
    If Cells(i, "E") >= 1 Then
        If sat > 65533 Then
            MsgBox "Satır doldu Başka kayıt yapamazsınız..!!", vbCritical, "SAYFA DOLDU"
            Exit Sub
        End If
        Range("A" & i & ":H" & i).Copy Sheets("arsiv").Range("A" & sat)
        Range("A" & i & ":H" & i).Delete (xlUp)
        sat = sat + 1
    End If
Next i
On Error Resume Next
Sheets("arsiv").Range("A2:H" & sat).Sort Sheets("arsiv").Range("A2")
Application.ScreenUpdating = True
End Sub

 

[Barons]

Bu ne hızdır.. Fedeal ve Evren arkadaşıma çok çok teşekkürler..çözümler mükemmel