Veri Aktarırken Satır Silme

[m.ensar]

Günaydın Arkadaşlar;
MsgBox a - 1 & ". veri " & Cells(a, "S") & " sayfasına aktarıldı.", vbInformation
If Cells(a, "S") <> "ONAY" Then
ActiveCell.EntireRow.Delete
Cells(a + 1, "U").Select
End If
End Sub

Bu koda 2. ci bir sayfayı nasıl ekleyebilirim. Onay sayfasına gönderdiğim veriyi silme diyor ya burada bunu ONAY sayfası ve ÖDEME sayfasına gönderdiğim veriyi silme şeklinde nasıl yaparız. Yani buraya bir sayfa daha eklemem gerekiyor.
Teşekkür ederim şimdiden

 

[Korhan Ayhan]

Merhaba,

Örnek dosya paylaşmanız sorunun çözümü için daha faydalı olabilir..

 

[alicimri]

ONAY sayfasındaki S sütundaki veriye göre belirlediğiniz satırı ÖDEME sayfasına aktarmak ve bu satısı silmek mi istiyorsunuz.
S. sütununda aktarılıp, silinecek satırı neye göre belirliyorsunuz.

 

[m.ensar]

Hocalarım teşekkür ediyorum ilginize; X sayfasında ki veriyi çeşitli sayfalara aktarıyorum. Bunu yaparken ONAY sayfasına gönderdiklerimi sildirmiyor yukarıda ki kod bunun yanında ÖDEME sayfasına aktarılan veriyi de silmesin istiyorum. ONAY ve ÖDEME sayfalarına aktarma yaparken silmesin diğer sayfalara aktarırken silsin istiyorum. Korhan hocam örnek çalışma ekliyorum.

 

[m.ensar]

GÜNCEL sayfasından yapılan aktarmalar da gerekli bu işlem ek eklemeden önce yazdığım için X sayfası demiştim. kusura bakmayın

 

[m.ensar]

Bir çözümü yok mu? Hocalarım

 

[Korhan Ayhan]

Ben ancak akşam evden bakabilirim. İşyerindeki pc'de Türkçe karakter sorunu yaşıyorum..

 

[m.ensar]

teşekkür ediyorum Korhan Hocam çok sağolasın

 

[Astalavista58]

Merhaba, anladığım GÜNCEL sayfasının "S" sütunundaki değer "ONAY" veya "ÖDEME" ise aktardıktan sonra bu satır silinmesin istiyorsunuz. Eğer öyle ise aşağıdaki kod işinizi görecektir.

Private Sub ListBox1_Click()
    a = ActiveCell.Row
    ActiveCell = ListBox1.Value
    ListBox1.Visible = False
    ActiveCell.Offset(0, 1).Select
    If WorksheetFunction.CountBlank(Range("A" & a & ":T" & a)) > 0 Then
        MsgBox "Lütfen tüm alanları doldurunuz!"
        Set c = Range("A" & a & ":T" & a).Find("")
        If Not c Is Nothing Then c.Select
    Else
        For i = 1 To Sheets.Count
            If Sheets(i).Name = Cells(a, "S") Then
                yeni = Sheets(i).Cells(Rows.Count, "A").End(3).Row + 1
                Range("A" & a & ":T" & a).Copy Sheets(i).Cells(yeni, "A")
            End If
        Next
    End If
    If Cells(a, "S") <> "ONAY" And Cells(a, "S") <> "ÖDEME" Then ' ONAY veya ÖDEME sayfalarına aktarılanları silme
        ActiveCell.EntireRow.Delete
        Cells(a + 1, "U").Select
    End If
End Sub

 

[m.ensar]

Hocam çok teşekkür ediyorum tam olarak istediğim bu idi emeğinize sağlık