Bir sayfadan diğer sayfalara koşullu veri aktarma

[emrahcalis]

Öncelikle herkese merhaba Yapmak istediğim şey dosyamdaki veri isimli sayfadaki "Ust" başlıklı sütunu baz alarak sayfaya veri girişi yapıldığı anda otomatik olarak buradaki AA olanları sarı ile işaretli alanlarını AA sayfasına, BB olanları BB sayfasına CC CC'ye, DD DD'ye şeklinde göndermesini istiyorum. Şimdiden yardım ve geri dönüşleriniz için teşekkür ederim.

 

[Necdet]

Merhaba,

"Sayfaya veri girişi yapıldığı anda" demişsiniz. Bunu nasıl anlayacağız, ilerde yanlışlıklara da neden olabilir. O yüzden ben istediğiniz an aktarma yapacağınız kod yazdım. Hangi satırın aktarıldığını kontrol etmek için de veri sayfasında son sütun olan Q sütununu kullandım.
Q sütunu boş olan satırlar ilgili sayfalara aktarılır.

Aşağıdaki kodları Bir Modüle kopyalayıp deneyiniz.

Sub Aktar()

    Dim i   As Long, _
        j   As Long, _
        Syf As String, _
        ShV As Worksheet, _
        Adt As Integer
    
    Set ShV = Sheets("veri")

    For i = 2 To ShV.Cells(Rows.Count, "A").End(3).Row
        If ShV.Cells(i, "Q") = "" Then
            Syf = ShV.Cells(i, "E")
            j = Sheets(Syf).Cells(Rows.Count, "A").End(3).Row + 1
            Sheets(Syf).Cells(j, "A") = ShV.Cells(i, "E")
            Sheets(Syf).Cells(j, "B") = ShV.Cells(i, "F")
            Sheets(Syf).Cells(j, "C") = ShV.Cells(i, "G")
            Sheets(Syf).Cells(j, "D") = ShV.Cells(i, "H")
            Sheets(Syf).Cells(j, "E") = ShV.Cells(i, "I")
            Sheets(Syf).Cells(j, "F") = ShV.Cells(i, "K")
            Sheets(Syf).Cells(j, "G") = ShV.Cells(i, "O")
            ShV.Cells(i, "Q") = "Aktarıldı"
            Adt = Adt + 1
        End If
    Next i
    
    If Adt = 0 Then
        MsgBox "Aktarılacak Kayıt Bulunamadı...."
    Else
        MsgBox Adt & " ADET KAYIT AKTARILMIŞTIR...."
    End If
End Sub

 

[emrahcalis]

Necdet Bey çok çok teşekkür ederim, tam istediğim gibi olmuş gayet iyi çalışıyor