Sayfa Korumalı Listeleme Yapma

[beyinmuhendisi]

Korhan Ayhan üstadım. Teşekkür ederim!

Benim için çok ilginç bir bilgi oldu.

 

[beyinmuhendisi]

Kod diğer sayfalara köprü bağlantısında hata veriyordu. İzninizle kodda değişiklik yaptım belki birilerine faydalı olur diye ekliyorum.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Satır As Range, Sütun As Range
[COLOR="Red"]Sheets("Liste").Unprotect ""[/COLOR]
If Intersect(Target, [A5:L3504]) Is Nothing Then
On Error Resume Next
[A5:Q3504].FormatConditions.Delete
On Error GoTo 0
Exit Sub
End If		
Set Satır = Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 12))
Set Sütun = Range(Cells(4, ActiveCell.Column), Cells(3504, ActiveCell.Column))

Cells.FormatConditions.Delete

With Satır
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 14
End With

With Sütun
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 56
End With

With ActiveCell
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=1
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 1
End With
ActiveSheet.Protect ""
End Sub