Makroya ilave

[mavi674]

Selam Hocalarım

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [C7:C1000,I7:I1000,O7:O1000]) Is Nothing Then Exit Sub

If Target.Column = 3 Then

Cells(Target.Row, "B") = Format(Now, "dd.mm.yyyy")

Else

Cells(Target.Row, "H") = Format(Now, "dd.mm.yyyy")

End If

End Sub

Acaba bu makroya

Cells(Target.Row, "N") = Format(Now, "dd.mm.yyyy") ekleyebilirmiyiz Hatta bu 6 sütuna kadardevam edecek Cells(Target.Row, "U") = Format(Now, "dd.mm.yyyy") bu gibi Bunu 6 Sütun için yapabilir miyiz ? Çok teşekkürler....

 

[mavi674]

Selam arkadaşlar
Cevap yazan olmadı
çalıştım aşağıdaki kodu yapabildim
Ancak;
C - I Sütunlarına veri girince işlem tamam makro düzgün çalışıyor
Ama O - U Sütunları sorunlu O Sütununa veri girince U Sütunuda veri girmiş gibi çalışıyor
O - U ayırabilirsek işlem tamam olacak
Lütfen Yardım


Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [C7:C1000,I7:I1000,O7:O1000,P71000]) Is Nothing Then Exit Sub

sayfaucreti = Range("A4")
sayfaucreti2 = Range("G4")
sayfaucreti3 = Range("M4")
sayfaucreti4 = Range("S4")


If Target.Column = 3 Then
Cells(Target.Row, "B") = Format(Now, "dd.mm.yyyy")
Cells(Target.Row, "D") = (sayfaucreti)
Else
Cells(Target.Row, "H") = Format(Now, "dd.mm.yyyy")
Cells(Target.Row, "J") = (sayfaucreti2)
End If

If Target.Column = 15 Then
Cells(Target.Row, "N") = Format(Now, "dd.mm.yyyy")
Cells(Target.Row, "P") = (sayfaucreti3)
Else

Cells(Target.Row, "T") = Format(Now, "dd.mm.yyyy")
Cells(Target.Row, "V") = (sayfaucreti4)
End If

'If Target.Column = 21 Then (bunu koyamadım)
End Sub

 

[ÖmerBey]

Merhaba,
Aşağıdaki şekilde deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C7:C1000,I7:I1000,O7:O1000,U7:U1000]) Is Nothing Then Exit Sub
Target.Offset(0, -1) = Format(Now, "dd.mm.yyyy")
Target.Offset(0, 1) = Cells(4, Target.Column - 2)
End Sub

Not: Kullanımınıza göre hata denetimi gerekebilir.

 

[mavi674]

Sonunda yaptım

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [C7:C1000,I7:I1000,O7:O1000,U7:U1000]) Is Nothing Then Exit Sub

sayfaucreti = Range("A4")

sayfaucreti2 = Range("G4")

sayfaucreti3 = Range("M4")

sayfaucreti4 = Range("S4")

If Target.Column = 3 Then

Cells(Target.Row, "B") = Format(Now, "dd.mm.yyyy")

Cells(Target.Row, "D") = (sayfaucreti)

ElseIf Target.Column = 9 Then

Cells(Target.Row, "H") = Format(Now, "dd.mm.yyyy")

Cells(Target.Row, "J") = (sayfaucreti2)

ElseIf Target.Column = 15 Then

Cells(Target.Row, "N") = Format(Now, "dd.mm.yyyy")

Cells(Target.Row, "P") = (sayfaucreti3)

ElseIf Target.Column = 21 Then

Cells(Target.Row, "T") = Format(Now, "dd.mm.yyyy")

Cells(Target.Row, "V") = (sayfaucreti4)

End If

End Sub

 

[mavi674]

Ömer Bey
mesajınızı şimdi gördüm
Deniyorummmm
Teşekkürler...

 

[ÖmerBey]

mesajınızı şimdi gördüm
Deniyorummmm

Bence boş verin. En iyi çözüm kendi bulduğunuz çözümdür.
İyi çalışmalar...

 

[mavi674]

Ömer Bey
kodunuzu denedim çalıştıramadım

 

[mavi674]

Tamamdır
Çok Teşekkürler