Hücre değerine göre komple satırı silip yeni sayfaya kopyalama

[aercin]

Sayfa1 de G sütunundaki değer "Teslim Edildi" ise satırın silinip Sayfa2 ye eklenmesini istiyorum. Sayfa1 e yeni satırlar eklendikçe veya G sütunundaki değer "Teslim Edildi" olarak değiştikçe Sayfa1 den silinip Sayfa2 deki son satırdan sonra eklenmeye devam edecek. Şimdiden teşekkürler.

 

[aercin]

N.Ziya Hiçdurmaz ustanın başka bir örneğine bakarak Sayfa2 ye kopyalamayı başardım. Şimdi silmeyi araştırıyorum. Daha önce bulan olursa sevinirim.
Sub TEST()
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("Sayfa2")
For k = 1 To 1000
If s1.Range("g" & k).Value = "Teslim Edildi" Then
say = WorksheetFunction.CountA(s2.[g1:g65000]) + 1
s2.Range("a" & say).Value = s1.Range("a" & k).Value
s2.Range("b" & say).Value = s1.Range("b" & k).Value
s2.Range("c" & say).Value = s1.Range("c" & k).Value
s2.Range("d" & say).Value = s1.Range("d" & k).Value
s2.Range("e" & say).Value = s1.Range("e" & k).Value
s2.Range("f" & say).Value = s1.Range("f" & k).Value
s2.Range("g" & say).Value = s1.Range("g" & k).Value
End If
Next k
End Sub

 

[aercin]

Sanırım konuyu Makro bölümüne açmalıydım. Sayfa1 deki G sütunu seçilerek Change olayına;
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("Sayfa2")
For k = 1 To 1000
If s1.Range("g" & k).Value = "Teslim Edildi" Then
say = WorksheetFunction.CountA(s2.[g1:g65000]) + 1
s2.Range("a" & say).Value = s1.Range("a" & k).Value
s2.Range("b" & say).Value = s1.Range("b" & k).Value
s2.Range("c" & say).Value = s1.Range("c" & k).Value
s2.Range("d" & say).Value = s1.Range("d" & k).Value
s2.Range("e" & say).Value = s1.Range("e" & k).Value
s2.Range("f" & say).Value = s1.Range("f" & k).Value
s2.Range("g" & say).Value = s1.Range("g" & k).Value
s1.Rows(k).Delete Shift:=xlUp
End If
Next k
Application.ScreenUpdating = True
End Sub

Yazarak istediğim şeyi elde ettim. Paylaşayım dedim, faydası olur umarım.