Kullandığım Makroya güncel tarih attırabilmek

[harziyan]

Sub aktar()
Dim sa As Worksheet
Dim sat, son As Long
Set sa = Sheets("Aktar")
Set sv = Sheets("MazotGubre İcmal-1")
son = sa.Cells(65536, "a").End(xlUp).Row + 1
For sat = 4 To Cells(65536, "a").End(xlUp).Row
If sv.Cells(sat, "a") = sv.Range("a1").Value Then
Range(sv.Cells(sat, "a"), sv.Cells(sat, "n")).Copy Range(sa.Cells(son, "a"), sa.Cells(son, "n"))
End If: Next
End Sub

Yukarıda kullandığım makronun kayıt yaptığı satırın en sağına bugünün de tarihini atmasını istiyorum. Sağa doğru sekiz hücre kullanıyorum. A3 ile H3 hücreleri arası. yani ben bugünün tarihini I3'e yazdırmak istiyorum. yardımlarınız için teşekkürler.

 

[fedeal]

Sub aktar()
Dim sa As Worksheet
Dim sat, son As Long
Set sa = Sheets("Aktar")
Set sv = Sheets("MazotGubre İcmal-1")
son = sa.Cells(65536, "a").End(xlUp).Row + 1
For sat = 4 To Cells(65536, "a").End(xlUp).Row
If sv.Cells(sat, "a") = sv.Range("a1").Value Then
Range(sv.Cells(sat, "a"), sv.Cells(sat, "n")).Copy Range(sa.Cells(son, "a"), sa.Cells(son, "n"))
[COLOR="Red"]sa.range("I"&sat).value= now[/COLOR]
End If: Next
End Sub

.

kırmızı satır işinizi görür umarım.iyi çalışmalar.

 

[Emsdmr]

Doğru mu anlamışım acaba

 

[harziyan]

maalesef olmadı hocam. ben her defasında kayıtla birlikte aşağıya doğru tarihi attırmak istiyorum. yani I3, I4, I5,.... alt alta kayıt yaptıkça her defasında o günün tarihini yazdırmak istiyorum. tekrar ilgilenebilirseniz sevinirim.
Özür dileyerek dosyamı ekliyorum.
Sistemde A1 hücresine TC NO yazınca kayıt yapılıyor.

 

[fedeal]

olmaz çünkü yanlış yapmışım

sa.Range("I" & son).Value = Now

dogrusu bu olacak,saygılar.

 

[harziyan]

Sn Fedeal; dosyayı tekrar kontrol ettim verdiğiniz ilave koddan sonra tarih atma işlevi gerçekleşiyor ancak, tek kayıt yaptığımda tuhaf bir şekilde I1104, I3298, I5467, I7618, I9825... hücrelerine tarih atılıyor.

 

[harziyan]

Mesajlarımız aynı dakikaya denk gelmiş en son verdiğiniz kod mükkemmel işliyor. Saygılar sunarım.