hücre açıklama kopyalama

[sgultegin]

sorunum ekteki dosyada açıklamış bulunmaktayım yardımlarınız için şimdiden teşekkür ederim.

 

[Ömer]

Merhaba,

Sayfa2 nin kod sayfasına kopyalayın. A2:A3 aralığını genişletebilirsiniz..

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, S1 As Worksheet
Set S1 = Sheets("Sayfa1")
Application.EnableEvents = False
If Intersect(Target, [[COLOR=red]A2:A3[/COLOR]]) Is Nothing Then Exit Sub
If Target = "" Then Target.ClearContents
    Set c = S1.[A:A].Find(Target, LookIn:=xlValues)
    If Not c Is Nothing Then
        S1.Range("A" & c.Row).Copy Target
    End If
Set S1 = Nothing
Application.EnableEvents = True
End Sub

.

 

[sgultegin]

çok teşekkür ederim.istediğim gibi olmuş.SAYFA2 DE BU FORMÜLÜ YAZDIM OLDU AMA HÜCRE AÇIKLAMASI GİZLİ OLARAK GELSİN BEN MOUSE İLE ÜSTÜNE GELİNCE GÖRÜNMESİNİ İSTİYORUM OLABİLİR Mİ?

 

[Ömer]

Bu şekilde deneyin..

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, S1 As Worksheet
Set S1 = Sheets("Sayfa1")
Application.EnableEvents = False
If Intersect(Target, [A2:A3]) Is Nothing Then Exit Sub
If Target = "" Then Target.ClearContents
    Set c = S1.[A:A].Find(Target, LookIn:=xlValues)
    If Not c Is Nothing Then
        S1.Range("A" & c.Row).Copy Target
    End If
[COLOR=red]Target.Comment.Visible = False[/COLOR]
Set S1 = Nothing
Application.EnableEvents = True
End Sub