Otomatik Tarih ve Hücre Güncelleme

@1903emre34

Belgedeki kodun başlangıç kısmını şöyle değiştirerek deneyin.

Üstad, olmadı, kullandığım kod

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Or Target.Column = 4 Then
If Cells(Target.Row, 1).Text = "003" And IsDate(Cells(Target.Row, 4)) Then
Cells(Target.Row, 6) = DateSerial(Year(Cells(Target.Row, 4)) + 1, 1, 1)
Cells(Target.Row, 7) = DateSerial(Year(Cells(Target.Row, 4)) + 1, 12, 31)
End If
End If
If Target.Column <> 2 And Target.Column <> 4 Then Exit Sub
Application.EnableEvents = False
XD = Target.Value2: x = Target.Column
If Len(XD) = 7 And x = 4 Then XD = "0" & XD
If Len(XD) = 6 And x = 2 Then XD = "0" & XD
If x = 2 Then
If Len(XD) = 7 And IsNumeric(Mid(XD, 1, 2)) And _
IsNumeric(Mid(XD, 4, 4)) And InStr(XD, "/") = 0 And InStr(XD, "-") = 0 Then _
Target.Value = Mid(XD, 1, 2) & "-" & Mid(XD, 4, 4) & "/" & Mid(XD, 1, 2) & "-" & Mid(XD, 4, 4)
ElseIf x = 4 Then
If XD = "" Then
Target.Offset(0, 2) = "": Target.Offset(0, 3) = ""
ElseIf Len(XD) = 8 And (InStr(XD, "-") = 0 Or IsDate(XD)) Then
trh = Mid(XD, 1, 2) & "-" & Mid(XD, 3, 2) & "-" & Mid(XD, 5, 4)
Target.NumberFormat = "@": Target.Value = trh
Target.Offset(0, 2).Resize(1, 2).NumberFormat = "@"
Target.Offset(0, 2).Value = trh: Target.Offset(0, 3).Value = trh
End If
End If
Application.EnableEvents = True
End Sub

Sıkıntıyı anladım sanırım.
Bir önceki önerimde belirttiğim değişikliği silip,
örnek belgede mevcut kodda yer alan Elseif.....Then satırından sonrasını şu hale getirin.

Hata verdi

@1903emre34

Belge ekte.

Merhaba,

Soru çözümlenmişti, yalnız şu anda otomatik basınca yandaki hücrelere tarih aktarılmıyor.

Teşekkürler evet çalışıyor