İki kodu birleştirme

[msetr]

İyi günler. Aşağıdaki kodu nasıl birleştirebilirim.

Birinci kod L sütununa ilgili satıra kayıt girince girilen isimdeki sayfaya kopyalıyor.

Aynı şekilde O sütununa ilgili satıra kayıt girince girilen isimdeki sayfaya kopyalamasını istiyorum.

Örnek olarak L sütununda ilgili satıra
TL Kasa yazınca TL Kasa sayfasına satırı kopyalasın
O sütununda Abc Ltd yazınca Abc Ltd sayfasına aynı satırı kopyalasın.

Yani aynı satırı hem L sütunundaki sayfa adına hemde O sütunundaki sayfaya kopyalasın.

Sayfaları ben kendim açabilirim. Sayfası olmayanlar kopyalanmasın.

Kısacası aşağıdaki iki kodu nasıl birleştirebilirim.

Ekte örnek dosya var.

Yardımcı olacak arkadaşlara şimdiden teşekkürler.



Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("L2:L" & Rows.Count)) Is Nothing Then Exit Sub
a = Target.Row
If Target.Offset(0, 4) <> "AKTARILDI" Then
If WorksheetFunction.CountBlank(Range("A" & a & ":N" & a)) = 0 Then
For sayfa = 1 To Sheets.Count
If Sheets(sayfa).Name = Target Then
yeni = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row + 1
Range("A" & a & ":O" & a).Copy Sheets(sayfa).Cells(yeni, "A")
sayfa = Sheets.Count
Target.Offset(0, 4) = "AKTARILDI"
End If
Next
End If
End If




If Intersect(Target, Range("O2:O" & Rows.Count)) Is Nothing Then Exit Sub
a = Target.Row
If Target.Offset(0, 2) <> "AKTARILDI" Then
If WorksheetFunction.CountBlank(Range("A" & a & ":O" & a)) = 0 Then
For sayfa = 1 To Sheets.Count
If Sheets(sayfa).Name = Target Then
yeni = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row + 1
Range("A" & a & ":O" & a).Copy Sheets(sayfa).Cells(yeni, "A")
sayfa = Sheets.Count
Target.Offset(0, 2) = "AKTARILDI"
End If
Next
End If
End If
End Sub

 

[YUSUF44]

Sorunun çözümü çok basit aslında. Size kodun mantığını daha doğrusu nasıl çalıştığını anlatayım:

Bildiğimiz gibi bu kodlar sayfa olaylarına yani sayfada yapılan değişikliklere bağlı olarak çalışan kodlardır.

Sizin kodların ikinci satırında yer alan;

If Intersect(Target, Range("L2:L" & Rows.Count)) Is Nothing Then Exit Sub

Satırında diyoruz ki "Eğer TARGET, yani o anda işlem yapılmakta/değişmekte olan hücre, L2:L&son satır aralığında DEĞİLSE Exit Sub, yani çalışmayı bırak, eğer L2:L&son satır aralığındaysa aşağıdaki işlemleri yap."

Gördüğünüz gibi biz zaten kodda diyoruz ki "Eğer değişen hücre L sütununda değilse bir şey yapmana gerek yok", kod da L sütunu dışındaki sütunlarda kodun geri kalanına bakmadan çalışmayı durduruyor, işlem yapmıyor.

Peki bunun önüne nasıl geçeriz, yani farklı hücreler/alanlar için sayfa olaylarını nasıl kullanırız?

Bunun farklı yöntemleri var, en bilinen ve en çok kullanılan yöntemde o satırın sonuna Exit sub değil de Goto 10 gibi bir ifade yazarız:

If Intersect(Target, Range("L2:L" & Rows.Count)) Is Nothing Then GoTo 10

Bu kodda diyoruz ki "Eğer target/değişen hücre L sütununda değilse 10 olarak belirlenen SATIRA GİT."

Daha sonra da L sütunu olmadığında yapılacak işlemlerin olduğu kod bloğunun başına 10: ifadesi yazarız ki kod oraya atlasın ve o satırdan sonraki işlemleri yapabilsin.

10:
If Intersect(Target, Range("O2:O" & Rows.Count)) Is Nothing Then Exit Sub

Bunu daha fazla kod bloğu için de kullanabilirsiniz. Eğer üçüncü bir blok olsaydı

10:
If Intersect(Target, Range("O2:O" & Rows.Count)) Is Nothing Then GoTo 20

Şeklinde kullanır ve bir sonraki blokta eğer başka şartımız yoksa exit sub kullanabilir ya da başka şartlarımız varsa ona göre yeni GoTo'lar kullanabiliriz.

Sonuç olarak sizin kodlarınızın bu anlattıklarıma göre son hali şöyle oluyor:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("L2:L" & Rows.Count)) Is Nothing Then [B][COLOR="Red"]GoTo 10[/COLOR][/B]
a = Target.Row
If Target.Offset(0, 4) <> "AKTARILDI" Then
    If WorksheetFunction.CountBlank(Range("A" & a & ":N" & a)) = 0 Then
        For sayfa = 1 To Sheets.Count
            If Sheets(sayfa).Name = Target Then
                yeni = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row + 1
                Range("A" & a & ":O" & a).Copy Sheets(sayfa).Cells(yeni, "A")
                sayfa = Sheets.Count
                Target.Offset(0, 4) = "AKTARILDI"
            End If
        Next
    End If
End If

[COLOR="red"][B]10:[/B][/COLOR]
If Intersect(Target, Range("O2:O" & Rows.Count)) Is Nothing Then [COLOR="red"][B]Exit Sub[/B][/COLOR]
a = Target.Row
If Target.Offset(0, 2) <> "AKTARILDI" Then
    If WorksheetFunction.CountBlank(Range("A" & a & ":O" & a)) = 0 Then
        For sayfa = 1 To Sheets.Count
            If Sheets(sayfa).Name = Target Then
                yeni = Sheets(sayfa).Cells(Rows.Count, "A").End(3).Row + 1
                Range("A" & a & ":O" & a).Copy Sheets(sayfa).Cells(yeni, "A")
                sayfa = Sheets.Count
                Target.Offset(0, 2) = "AKTARILDI"
            End If
        Next
    End If
End If
End Sub

 

[msetr]

Yusuf Bey cevabınız için çok teşekkürler. Vb kodların işlevlerini tam çözemedim. Sayenizde biraz olsun bir şeyler öğrenmeye çalışıyorum. Kod çalışıyor problem yok. İyi günler kolay gelsin.