- Katılım
- 1 Temmuz 2008
- Mesajlar
- 1,748
- Excel Vers. ve Dili
- 2019 TR
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Dosya görünmüyor. Bu arada imleç bulunan hücre olması şart mı? Seçili hücrenin bulunduğu satır olsa olmaz mı?
Öreği deneyiniz. A1:Q5 arası olarak ayarladım. Siz tablonuza göre aralığı genişletebilirsiniz.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone
If Intersect(Target, [A1:Q50]) Is Nothing Then Exit Sub
Range(Cells(Target.Row, 1), Cells(Target.Row, 17)).Interior.ColorIndex = 6
End Sub
Sayın Serkan YİĞİT,
Sanırım bunun sebebi Selection_Change olayı. İstediğiniz renklendirme olayı da ancak böyle olabilir.
Sorununuzu şu şekilde halledebilirsiniz. Hücreyi kopyalamak yerine, hücreyi çift tıklatıp içeriğini seçip kopyalayabilirsiniz. bu şekilde kopyalama yapıştır eylemini gerçekleştirebilirsiniz.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
[COLOR=red]If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub[/COLOR]
Cells.Interior.ColorIndex = xlNone
If Intersect(Target, [A1:Q50]) Is Nothing Then Exit Sub
Range(Cells(Target.Row, 1), Cells(Target.Row, 17)).Interior.ColorIndex = 6
End Sub
Selamlar,
Kopyalama işlemindeki sıkıntıyı kırmızı renkli satırı ekleyerek çözebilirsiniz.
Kod:Private Sub Worksheet_SelectionChange(ByVal Target As Range) [COLOR=red]If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub[/COLOR] Cells.Interior.ColorIndex = xlNone If Intersect(Target, [A1:Q50]) Is Nothing Then Exit Sub Range(Cells(Target.Row, 1), Cells(Target.Row, 17)).Interior.ColorIndex = 6 End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
Cells.Interior.ColorIndex = xlNone
If Intersect(Target, [A1:Q50]) Is Nothing Then Exit Sub
Range(Cells(Target.Row, 1), Cells(Target.Row, 17)).Interior.ColorIndex = 6
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone
If Intersect(Target, [A1:Q5]) Is Nothing Then Exit Sub
Range(Cells(Target.Row, 1), Cells(Target.Row, 17)).Interior.ColorIndex = 6
ActiveCell.Interior.ColorIndex = 7
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
Cells.Interior.ColorIndex = xlNone
If Intersect(Target, [A1:Q50]) Is Nothing Then Exit Sub
Range(Cells(Target.Row, 1), Cells(Target.Row, 17)).Interior.ColorIndex = 38
[COLOR=red]Target.Interior.ColorIndex = 6[/COLOR]
End Sub