Hücredeki Veri Kopyalandı İse

[pylor]

Değerli excel web uzmanları formda bulduğum bir kod yardımı ile veri girişi yaptığım belirli satır aralığını belirli renkler ile biçimlendiriyorum örneğin D1 hücresinde kolonoskopi yazıyorsa A1 ve F1 hücre aralığı sarı renge boyanıyor benim istediğim B1 hücresindeki kabul numarası kopyalandığından A1 ve F1 hücre aralığının rengi kalksın yardımlarınız için şimdiden teşekkür ederim

 

[asi_kral]

Değerli excel web uzmanları formda bulduğum bir kod yardımı ile veri girişi yaptığım belirli satır aralığını belirli renkler ile biçimlendiriyorum örneğin D1 hücresinde kolonoskopi yazıyorsa A1 ve F1 hücre aralığı sarı renge boyanıyor benim istediğim B1 hücresindeki kabul numarası kopyalandığından A1 ve F1 hücre aralığının rengi kalksın yardımlarınız için şimdiden teşekkür ederim

Merhaba
Kodu gönderebilir misiniz_?
Dosya ile birlikte

 

[pylor]

sayın asi kral formda bulduğum kodları gönderiyorum ben bu kodları kendime uyarladım dosyadaki B sütünu kendime uyarlanmış şeklindedir yardımınızdan dolayı teşekkür ederim

 

[asi_kral]

sayın asi kral formda bulduğum kodları gönderiyorum ben bu kodları kendime uyarladım dosyadaki B sütünu kendime uyarlanmış şeklindedir yardımınızdan dolayı teşekkür ederim

Merhaba
Sayfadaki kodu konunla değiştirip dener misiniz_?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Konu       :   Kayıtları Renklendir ve Renk Kaldır
'Mail       :   m.batu.1967@gmail.com
'Coder By   :   asi_kral_1967
'Not        :   Koda düzeltme yapılmıştır.
Dim sat As Integer
Application.EnableEvents = False
If Target.Column = 1 Then
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
[a2:j1000].Interior.ColorIndex = xlNone
For sat = 2 To Cells(65536, "H").End(xlUp).Row
If Cells(sat, "h") = 100 Then Range(Cells(sat, "a"), Cells(sat, "j")).Interior.ColorIndex = 6
If Cells(sat, "h") = 75 Then Range(Cells(sat, "a"), Cells(sat, "j")).Interior.ColorIndex = 5
If Cells(sat, "h") = 40 Then Range(Cells(sat, "a"), Cells(sat, "j")).Interior.ColorIndex = 24
If Cells(sat, "h") = 50 Then Range(Cells(sat, "a"), Cells(sat, "j")).Interior.ColorIndex = 7
If Cells(sat, "h") = 0 Then Range(Cells(sat, "a"), Cells(sat, "j")).Interior.ColorIndex = 3
Next
ElseIf Target.Column = 2 Then
If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
Range(Cells(Target.Row, "A"), Cells(Target.Row, "J")).Interior.ColorIndex = xlNone
End If
Application.EnableEvents = True
End Sub

Dosyanız Ekte

 

[pylor]

sayın asi kral değerli vaktinizi ayırıp soruma cevap verdiğiniz için teşekkür ederim ama galiba kodlarda bir yanlışlık var örneğin B sütununda bir hücreye tıkladığım anda satırın renkleri siliniyor oysa ben hücreye tıklandığında değil hücre kopyalandığı zaman satır renginin silinmesini istiyorum birde eklediğiniz kodlardan sonra H sütünuna tekrar veri girişi yaptığımda satır gerekli biçime bürünmüyor herşey sabit kalıyor örneğin B1 hüçresine tıkladığım zaman satırın rengi siliniyor ve H1 hücresine tekrar veri girişi yaptığımda satır alması gereken rengi almıyor ancak
A sütununda herhangi bir hücreye tıkladığımda hücreler renklerine kavuşuyor benim sizden istediğim B1 kopyalandığı zaman satır rengi silinsin ve H1 hücresine yeni veri girişi yaptığımda satır ilgili renge bürünsün yardımlarınız için tekrar teşekkü ederim iyi akşamlar

 

[asi_kral]

sayın asi kral değerli vaktinizi ayırıp soruma cevap verdiğiniz için teşekkür ederim ama galiba kodlarda bir yanlışlık var örneğin B sütununda bir hücreye tıkladığım anda satırın renkleri siliniyor oysa ben hücreye tıklandığında değil hücre kopyalandığı zaman satır renginin silinmesini istiyorum birde eklediğiniz kodlardan sonra H sütünuna tekrar veri girişi yaptığımda satır gerekli biçime bürünmüyor herşey sabit kalıyor örneğin B1 hüçresine tıkladığım zaman satırın rengi siliniyor ve H1 hücresine tekrar veri girişi yaptığımda satır alması gereken rengi almıyor ancak
A sütununda herhangi bir hücreye tıkladığımda hücreler renklerine kavuşuyor benim sizden istediğim B1 kopyalandığı zaman satır rengi silinsin ve H1 hücresine yeni veri girişi yaptığımda satır ilgili renge bürünsün yardımlarınız için tekrar teşekkü ederim iyi akşamlar

Merhaba
Çok özür dilerim dalgınlığıma denk geldi aynı yere yazmışım.
Kodu bununla değiştirip dener misiniz_?

Private Sub Worksheet_Change(ByVal Target As Range)
'Konu       :   Kayıtları Renklendir ve Renk Kaldır
'Mail       :   m.batu.1967@gmail.com
'Coder By   :   asi_kral_1967
If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
Range(Cells(Target.Row, "A"), Cells(Target.Row, "J")).Interior.ColorIndex = xlNone
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Konu       :   Kayıtları Renklendir ve Renk Kaldır
'Mail       :   m.batu.1967@gmail.com
'Coder By   :   asi_kral_1967
Application.EnableEvents = False
If Target.Row < Range("A" & Rows.Count).End(xlUp).Row Then
If Target.Column = 1 Then
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
If Cells(Target.Row, "h") = 100 Then Range(Cells(Target.Row, "a"), Cells(Target.Row, "j")).Interior.ColorIndex = 6
If Cells(Target.Row, "h") = 75 Then Range(Cells(Target.Row, "a"), Cells(Target.Row, "j")).Interior.ColorIndex = 5
If Cells(Target.Row, "h") = 40 Then Range(Cells(Target.Row, "a"), Cells(Target.Row, "j")).Interior.ColorIndex = 24
If Cells(Target.Row, "h") = 50 Then Range(Cells(Target.Row, "a"), Cells(Target.Row, "j")).Interior.ColorIndex = 7
If Cells(Target.Row, "h") = 0 Then Range(Cells(Target.Row, "a"), Cells(Target.Row, "j")).Interior.ColorIndex = 3
ElseIf Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Or Target.Column = 6 Or Target.Column = 7 _
Or Target.Column = 8 Or Target.Column = 9 Or Target.Column = 10 Then
If Intersect(Target, [C:J]) Is Nothing Then Exit Sub
If Cells(Target.Row, "h") = 100 Then Range(Cells(Target.Row, "a"), Cells(Target.Row, "j")).Interior.ColorIndex = 6
If Cells(Target.Row, "h") = 75 Then Range(Cells(Target.Row, "a"), Cells(Target.Row, "j")).Interior.ColorIndex = 5
If Cells(Target.Row, "h") = 40 Then Range(Cells(Target.Row, "a"), Cells(Target.Row, "j")).Interior.ColorIndex = 24
If Cells(Target.Row, "h") = 50 Then Range(Cells(Target.Row, "a"), Cells(Target.Row, "j")).Interior.ColorIndex = 7
If Cells(Target.Row, "h") = 0 Then Range(Cells(Target.Row, "a"), Cells(Target.Row, "j")).Interior.ColorIndex = 3
End If
Else
MsgBox "Bu Hücrelere Tıklamayınız", vbCritical, "asi_kral_1967"
End If
Application.EnableEvents = True
End Sub

 

[pylor]

sayın asi kral ilginiz için çok teşekkür ederim kodlarınız çalışıyor. affınıza sığınarak bir sorum daha olacak excel internet üzerinden veri alabiliyor peki intranet üzerinden veri alıp işlem yapabilirmi acaba ilginiz için tekrar teşekkürler iyi akşamlar

 

[asi_kral]

sayın asi kral ilginiz için çok teşekkür ederim kodlarınız çalışıyor. affınıza sığınarak bir sorum daha olacak excel internet üzerinden veri alabiliyor peki intranet üzerinden veri alıp işlem yapabilirmi acaba ilginiz için tekrar teşekkürler iyi akşamlar

Bu konu hakkında bir fikrim yok veri aldığını biliyorum ama hiç denemedim. Siz yeni konu açarak sorun sorunuzu bilmeyende yararlansın.