Soru Koşula göre veri kopyalama ve işi biten satırı silme

[bircan75]

Merhaba; Foruma uzun zaman önce kayıt olmuştum ama yeni takip etmeye başladım ve faydalanıyorum, kendim için oluşturduğum bir iş takip listem var. İlk başta makro yazma bilgim olmadığı için formüller ile bir yere kadar geldim ama sonuçta makro kullanmak zorunda kaldım. Forumda bulduğum bir kodu kendime uyarladım, güzel çalışıyor ancak uzun süredir araştırmama rağmen istediğim düzeltmeyi yapamadım yardımınıza ihtiyacım var.
Amacım "GÜNCEL" sayfasında açılır listeden "GİDEN" olarak seçilen satırda bulanan bilgiler yine "GİDEN" isimli sayfaya kopyalansın ve "GÜNCEL" sayfasından silinsin. Kod bu işlevi yerine getiyor ama bütün satırı kopyalayarak yapıştırıyor. A sütunu ve G ütunu ile sonrası kopyalanmasın sadece işlem yapılan satırda ki "B" ve "F" sütunları dahil arasındaki sütunlar kopyalanıp "GİDEN" sayfasında "B" sütunundan itibaren yapıştırılsın. Ben A sütununa sıra numarasını yazarım elle sıkıntı yok.

Örnek dosyamın linki: https://s6.dosya.tc/server3/nxl1mu/ornek_dosya.xlsm.html

Kullandığım kod:

Private Sub Worksheet_Activate()
Dim GÜNCEL_sonsat As Long, i As Long
GÜNCEL_sonsat = Sheets("GÜNCEL").Cells(65536, "G").End(xlUp).Row
'Sheets("GİDEN").Range("A1:M65536").ClearContents
For i = 1 To GÜNCEL_sonsat
If Sheets("GÜNCEL").Cells(i, "G").Value = "GİDEN" Then
    Sheets("GÜNCEL").Rows(i).Copy
    Sheets("GİDEN").Cells(Sheets("GİDEN").Cells(65536, "G").End(xlUp).Row + 1, "A").PasteSpecial
    Sheets("GÜNCEL").Rows(i).Delete
    i = i - 1
End If
Next
End Sub

Şimdiden herkese teşekkür ederim.

 

[muygun]

Merhaba;
GİDEN sayfasındaki kodlarda;

Sheets("GÜNCEL").Rows(i).Copy
Sheets("GİDEN").Cells(Sheets("GİDEN").Cells(65536, "G").End(xlUp).Row + 1, "A").PasteSpecial


satırlarını;

Sheets("GÜNCEL").Range("b" & i & ":ı" & i).Copy
Sheets("GİDEN").Cells(Sheets("GİDEN").Cells(65536, "G").End(xlUp).Row + 1, "b").PasteSpecial

Şeklinde düzenleyerek deneyin.
İyi çalışmalar.

 

[bircan75]

Merhaba;
GİDEN sayfasındaki kodlarda;

Sheets("GÜNCEL").Rows(i).Copy
Sheets("GİDEN").Cells(Sheets("GİDEN").Cells(65536, "G").End(xlUp).Row + 1, "A").PasteSpecial


satırlarını;

Sheets("GÜNCEL").Range("b" & i & ":ı" & i).Copy
Sheets("GİDEN").Cells(Sheets("GİDEN").Cells(65536, "G").End(xlUp).Row + 1, "b").PasteSpecial

Şeklinde düzenleyerek deneyin.
İyi çalışmalar.

Öncelikle çok teşekkür ederim. Basit ama bilgi gerektiren bir detaymış. "I" hücresini "F" olarak değiştirince tam anlamı ile CUK oturdu . Emeğinize sağlık iyi günler dilerim

 

[bircan75]

Sayın Moderatörler sorun çözümlendi, konu kapanabilir.