Çözüldü Sayfaya ait olan kodu tüm çalışma kitabına uygulamak

[vurkan]

Arkadaşlar merhaba
Daha önceki bir mesajıma cevaben Sayın turist Üstadın verdiği ve gayet güzel çalışan aşağıdaki kod; Sayfa kodu bölümüne yapıştırdığım sayfanın B sütununa yeni veri girdikçe hem sıralama yapıyor hem de o veriden daha önce varsa yapıştırmayarak veri tekrarını önlüyor.

Bir sayfayla çalışırken gayet güzel olan bu kodu çalışma kitabına her yeni sayfa ekledikçe aynı kodu o sayfalara da uygulamam gerekiyor.

Acaba bu kodda değişiklik yapılarak tüm çalışma kitabına uygulayıp çalışma kitabının olan ve yeni açılacak olan her sayfasının B sütunu için böyle bir özellik kazandırılabilir mi? Bunun için ne yapmak lazım? Şimdiden Teşekkürler.


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Columns("B")) Is Nothing Then Exit Sub
Dim say, son As Long
say = WorksheetFunction.CountIf(Columns("B"), Target.Value)
If say > 1 Then: Target.Clear
Columns("B:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
son = Cells(Rows.Count, "B").End(xlUp).Row + 1
Range("B" & son).Select
End Sub

 

[askm]

Bu çalışma kitabı bölümüne aşağıdaki şekilde eklerseniz olur.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Columns("B")) Is Nothing Then Exit Sub
Dim say, son As Long
say = WorksheetFunction.CountIf(Columns("B"), Target.Value)
If say > 1 Then: Target.Clear
Columns("B:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
son = Cells(Rows.Count, "B").End(xlUp).Row + 1
Range("B" & son).Select
End Sub

 

[vurkan]

Sayın askm verdiğiniz kod gayet güzel çalışıyor. İlginize teşekkür ederim