mükerrer kayıt takip (kod ile)

[hurkanpisirici]

merhabalar ekli dosyada 1. sayfa c sütununda firma listemn var ben bu listeye firma girdiğimde sayfa 2 nin a sütununa aynı liste oluşturulacak ama bir firma sadece bir kere 2 sayfa a sütununa gidecek bu kodu için bana yardım edecek bir arkadaş varmı acaba?

 

[BG]

bence fonksiyonla halledebilirsiniz!
1. sayfanın c. sütnunu seçip veri/doğrulama menüsüne bakın
dosya ektedir.

 

[BG]

aktarma işlemi formülünü eklememiştim, şimdi ekledim

 

[hurkanpisirici]

sayın brain ilginize teşekkür edeirm ama 1.kod istedim 2.si ise ben 1 sayfaya yazdıkça 2 sayfada bir liste oluşsun istedim uyarı olması şart değil ben bir firmayı iki kere yazsamda o firma 2. sayfaya bir kere gitsin.emeğniz için teşekkür edeirm sağolun

 

[hurkanpisirici]

forumda bir sürü örnek var ama istediğmi bulamadım

 

[Ayhan Ercan]

Merhaba Sn hrknp

Aşağıdaki Kodları Denermisiniz....

Private Sub Worksheet_Change(ByVal Target As Range)
Dim hcr As Range, son As Long
son = Sheets("Sayfa1").Range("C65536").End(3).Row
    For Each hcr In Sheets("Sayfa2").Range("A1:A" & Sheets("Sayfa2").Range("A65536").End(3).Row)
        If hcr.Value = Sheets("Sayfa1").Cells(son, 3).Value Then GoTo hata
    Next
Sheets("Sayfa2").Range("A" & Sheets("Sayfa2").Range("A65536").End(3).Row + 1) = Sheets("Sayfa1").Cells(son, 3).Value
hata:
End Sub

 

[hurkanpisirici]

istediğimin aynısı çok teşekkür ederim ellerinize sağlık

 

[Ayhan Ercan]

istediğimin aynısı çok teşekkür ederim ellerinize sağlık

Rica ederim.
İyi Çalışmalar... k::

 

[hurkanpisirici]

yapmaya çalıştım ama yapamadım 1 sayfa c yi 2. sayfa a ya atıyoruz, peki ben birer hücre daha ekelemek istesem yani 1 sayfa d yi 2. sayfa b ye nasıl atarım?

 

[hurkanpisirici]

sayın ercan bey soruyu eksik sorduğumu şimid farkettim birer hücre daha eklemem gerekiyordu?

 

[hurkanpisirici]

yardım edecek bir arkadaş yokmu acaba?

 

[Ayhan Ercan]

Tekrar Merhaba Sn hrknp

Private Sub Worksheet_Change(ByVal Target As Range)
Dim hcr As Range
With Sayfa2
    Set hcr = .Columns(Target.Column - 2).Find(Target.Value, lookat:=xlWhole)
    If Not hcr Is Nothing Then Exit Sub
    .Cells(.Cells(65536, Target.Column - 2).End(3).Row + 1, Target.Column - 2) = Target.Value
End With
End Sub

 

[hurkanpisirici]

ayhan bey teşekkür ederim ilgilendiğiniz için.Allahrazıolsun sağolun.

 

[Ayhan Ercan]

ayhan bey teşekkür ederim ilgilendiğiniz için.Allahrazıolsun sağolun.

Rica ederim.
İyi Çalışmalar.. k::