sayfa 1 de yazı yazdığımda sayfa 2 ye tarih attirma

[yNsr43]

iyi geceler arkadaşlar.
sayfa 1 de ahmet hücresinin yanindaki hücreye yazı yazdığımda
sayfa 2 deki ahmeti bulup yanindaki hücreye tarih atmasini istiyorum bunu nasıl yapabilirz. teşekkürler.

 

[Necdet]

Merhaba,

"Ahmet Hücresi" ne demek? Ahmet'in hücresi mi var?

örnek dosyanızı dosya.tc gibi paylaşım sitesine yüklerseniz sorunuz daha iyi anlaşılır.

 

[yNsr43]

pardon uyku sersemi yanlış aktarmişim Ahmet yazan hücre demek istemişyim

 

[Necdet]

pardon uyku sersemi yanlış aktarmişim Ahmet yazan hücre demek istemişyim

İyi de bu açıklama da yeterli değil.

 

[yNsr43]

http://s3.dosya.tc/server14/btgmc2/Yeni_Microsoft_Excel_Calisma_Sayfasi.rar.html

haklısnız örneği koydum
sayfa 1 deki isimlerin yanindaki hücreye birşey yazdiğimda
sayfa 2 de o isimleri bulup yanindaki sütuna tarih yazdirmak istiyorum.

teşekkürler.

 

[çıtır]

Sayfa1 kod olarak kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
 Set s1 = Sheets("Sayfa1")
 Set s2 = Sheets("sayfa2")
 son2 = s2.Cells(65536, "A").End(3).Row
On Error Resume Next
If Intersect(Target, Range("b2:b1000")) Is Nothing Then Exit Sub
t = WorksheetFunction.CountIf(s2.Range("A2:A" & son2), Target.Offset(0, -1))
If t > 0 Then
s = WorksheetFunction.Match(Target.Offset(0, -1), s2.Range("a2:a" & son2), 0)
If Target = "" Then
s2.Range("b" & s + 1) = ""
Else
s2.Range("b" & s + 1) = Format(Now, "dd.mm.yyyy")
End If
End If
End Sub

 

[yNsr43]

kod gelmedi.

 

[yNsr43]

teşekkürler.

 

[Necdet]

Merhaba,

Alternatif olsun, yine aşağıdaki kodları Sayfa1'in kod bölümüne kopyalayınız.
Sayfa1'in B sütununda silme yaptığınızda işlem yapmaz, yapmasını isterseniz kodda gereken yeri silin.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, [B:B]) Is Nothing Or Target.Row < 2 Or Target.Value = "" Then Exit Sub
    
    Dim s2  As Worksheet, _
        c   As Range
    Set s2 = Sheets("Sayfa2")
    
    Set c = s2.Range("A:A").Find(Target.Offset(0, -1), LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        s2.Cells(c.Row, "B") = Date
    End If
    
End Sub

 

[yNsr43]

sizede teşekkür ederim.
peki sayfa 3 ekleyip buraya açılan liste koyup kenarina yazilan rakami sayfa 1 e kopyalayip sayfa 2 yede tarih atabilirmiyiz.
teşekkürler.

http://s7.dosya.tc/server3/eib7ol/Yeni_Microsoft_Excel_Calisma_Sayfasi.rar.html

 

[çıtır]

Sayfa3 kodu olarak kopyalayınız.Sayfa3 D2 Hücresinde işlem yaptığınızda kod çalışır.
Diğer koda gerek yok.

Private Sub Worksheet_Change(ByVal Target As Range)
 Set s1 = Sheets("Sayfa1")
 Set s2 = Sheets("sayfa2")
  son1 = s1.Cells(65536, "A").End(3).Row
  son2 = s2.Cells(65536, "A").End(3).Row
If Intersect(Target, [D2]) Is Nothing Then Exit Sub
t = WorksheetFunction.CountIf(s1.Range("A2:A" & son1), Target.Offset(0, -1))
If t > 0 Then
s = WorksheetFunction.Match(Target.Offset(0, -1), s1.Range("a2:a" & son1), 0)
Z = WorksheetFunction.Match(Target.Offset(0, -1), s2.Range("a2:a" & son2), 0)
s1.Range("b" & s + 1) = Target.value
s2.Range("b" & Z + 1) = Format(Now, "dd.mm.yyyy")
End If
If Target.value = "" Then
  s1.Range("b" & s + 1) = ""
  s2.Range("b" & Z + 1) = ""
 End If
End Sub

 

[yNsr43]

teşekkür ederim.
D2 deki yaziyi sildiğimde sayfa1 deki veride siliniyor.

"s1.Range("b" & s + 1) = Target.Offset(0, 0)" bu kısımdan mı kaynaklanıyor acaba ?

 

[çıtır]

Bu kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
 Set s1 = Sheets("Sayfa1")
 Set s2 = Sheets("sayfa2")
 son1 = s1.Cells(65536, "A").End(3).Row
 son2 = s2.Cells(65536, "A").End(3).Row
If Intersect(Target, [D2]) Is Nothing Then Exit Sub
If Target.Value = "" Then
Exit Sub
End If
t = WorksheetFunction.CountIf(s1.Range("A2:A" & son1), Target.Offset(0, -1))
If t > 0 Then
s = WorksheetFunction.Match(Target.Offset(0, -1), s1.Range("a2:a" & son1), 0)
Z = WorksheetFunction.Match(Target.Offset(0, -1), s2.Range("a2:a" & son2), 0)
s1.Range("b" & s + 1) = Target.value
s2.Range("b" & Z + 1) = Format(Now, "dd.mm.yyyy")
End If
End Sub

 

[yNsr43]

teşekkürler eline sağlık.

 

[çıtır]

Rica ederim.Dönüş yaptığınız için teşekkür ederim.