Sayfaya veri girildiğinde diğer sayfanın belli hücrelerine tarih ekleme

[birikitrb]

Merhaba

Kendimce işlerimi basitleştirmek için bir çalışma sayfasıyla uğraşmaktayım.
sayfa1 de D6-D15 hücrelerine veri girildiğinde sayfa2 de E4-E13 hücrelerine "verinin girildiği tarihin üzerine 7 gün eklenerek" tarih atmasını istiyorum.
makro da oldukça yeniyim.
Yardım ederseniz memnun olurum.

 

[askm]

Sayfa1 Kod alanına aşağıdaki kodları ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim syf As Worksheet
Set syf = Sheets("Sayfa2")
Dim satir As Integer, sutun As Integer
satir = Target.Row: sutun = Target.Column

If sutun = 4 Then
    If satir > 5 And satir < 16 Then
        syf.Cells(satir, "E") = CDate(Date + 7)
    End If
End If
Set syf = Nothing
End Sub

 

[birikitrb]

Yazdığınız gibi Sayfa1 kod alanına belirttiğiniz kodları ekledim. Fakat sayfa1 de D6 hücresine yazdığım veri Sayfa 2 E6 hücresine tarih atıyor. Ben D6 karşılık E4 gelsin istiyorum.
Bir de rica etsem Sayfa1 de veri silindiği zaman sayfa 2 de tarih de silinebilecek şekilde yapabilir misiniz ?

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim My_Range As Range, S2 As Worksheet
  
    If Intersect(Target, Range("D6:D15")) Is Nothing Then Exit Sub
  
    Set S2 = Sheets("Sayfa2")

    For Each My_Range In Intersect(Target, Range("D6:D15"))
        If My_Range.Value <> "" Then
            S2.Range(My_Range.Address).Offset(-2, 1) = Date + 7
        Else
            S2.Range(My_Range.Address).Offset(-2, 1).ClearContents
        End If
    Next

    Set S2 = Nothing
End Sub

 

[birikitrb]

Bu kod ile gayet güzel oldu. Herkese çok teşekkür ederim. Kolay gelsin.

Deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim My_Range As Range, S2 As Worksheet
 
    Set S2 = Sheets("Sayfa2")

    For Each My_Range In Intersect(Target, Range("D6:D15"))
        If My_Range.Value <> "" Then
            S2.Range(My_Range.Address).Offset(-2, 1) = Date + 7
        Else
            S2.Range(My_Range.Address).Offset(-2, 1).ClearContents
        End If
    Next

    Set S2 = Nothing
End Sub

 

[birikitrb]

Kolay gelsin yukarıdaki kod güzel şekilde kullanıyordum ama sayfa 1 D5-D16 hücreleri dışından herhangi bir hücreye veri girdiğimde

"Run time error '424':
Object required

hatası alıyorum. Debug buttonuna tıkladığımda kod ekranının
" For Each My_Range In Intersect(Target, Range("D6: D15")) "
kısmı sarı renkte yanıyor.
Yardımlarınız bekliyorum.

 

[Korhan Ayhan]

#4 nolu mesajımda ki kodu revize ettim. Tekrar deneyiniz.

 

[birikitrb]

Tamamdır artık hata almıyorum. Teşekkür Ederim.