Sayfadaki yeni ismi diğer sayfaya aktarma

[hasnur999]

Sayın ütatlar takıldığım konu sayfa 1 e yazılan isimlere daha önce yazılmamış ilk defa yazılan isimi sayfa 2 de isimlerin olduğu alt satıra eklemesi böyle bişey olurmu.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu "1 sayfa" isimli sayfanızın kod bölümüne uygulayıp denermisiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BUL As Range

    If Target.Column <> 2 Then Exit Sub
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    If Target <> "" Then
        Set BUL = Sheets("2 sayfa").Range("B:B").Find(Target, , , xlWhole)
        If BUL Is Nothing Then
            Sheets("2 sayfa").Range("B65536").End(3).Offset(1) = Target
        End If
    End If

    Set BUL = Nothing
    Application.ScreenUpdating = True
End Sub

 

[N.Ziya Hiçdurmaz]

yanıt

Korhan hocam cevaplamış, bende bir önek yapmıştım. Dosyanızdaki formüller işlemi biraz ağırlaştırıyor.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sat As Integer
Dim s As Integer
If Intersect(Target, Sayfa1.[b2:b5000]) Is Nothing Then Exit Sub
s = 3
With Sayfa1
    For sat = 2 To .Cells(65536, "b").End(xlUp).Row
        If WorksheetFunction.CountIf(.[b:b], .Cells(sat, "b")) = 1 Then
            Sayfa2.Cells(s, "b") = .Cells(sat, "b").Value
            s = s + 1
        End If
    Next
    End With
End Sub

 

[slmnkc]

çok teşekkürler

 

[hasnur999]

Üstatlar çok teşekkür ederim.