Aktif hücre silindiğinde yan hücrenin bilgilere mesaj olarak gelsin

[ASLAN7410]

Merhaba hayırlı geceler.

Ekte gönderdiğim excel dosyamın 1.sayfasının kod bölümünde aşağıdaki kodlar mevcut, gayet güzel çalışıyor. A sütunundan her hangi bir hücreye çift tıkladığımda aktif hücre satırı siliniyor, ekrana örneğin 5.satır silindi mesajı geliyor.

Benim yapmak istediğim A sütunundan herhangi bir hücreyi çift tıklayarak sildiğim de, aktif hücrenin yanındaki B sütunundaki hücrenin bilgisinin mesaj bilgisi olarak gelmesini istiyorum.

Örnek olarak 8.satıra çift tıkladığımda, mesaja gelmesini istediğim GGG silinecek şeklinde olmasını istiyorum, bir türlü başaramadım.
Yardımcı olur musunuz?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
        soru = MsgBox(ActiveCell.Row & ". satır silinecek.", vbYesNo + vbInformation, "A S L A N")
    If soru = vbNo Then
    Cancel = True
    MsgBox ActiveCell.Row & ". satır silinmekten vazgeçildi.", vbInformation, "A S L A N"
    End If
    
    If soru = vbYes Then
    Rows(Target.Row & ":" & Target.Row).Delete
    Cancel = True
    
    On Error Resume Next
    For i = 2 To Sheets(1).Range("B65536").End(3).Row
    If Not Rows(i).Hidden = True Then
    st = st + 1
    Cells(i, "a") = st
    End If
    Next

    CreateObject("WScript.Shell").Popup ActiveCell.Row & ". satır silindi.", 1, "A S L A N", vbInformation
    End If
    
    Application.ScreenUpdating = True

End Sub

 

[Mustafa MUTLU]

Buyurun deneyin..
-------

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
MSTF = Cells(ActiveCell.Row, "b")
soru = MsgBox(Cells(ActiveCell.Row, "b") & ". satır silinecek.", vbYesNo + vbInformation, "MUTLU")
If soru = vbNo Then
Cancel = True
MsgBox Cells(ActiveCell.Row, "b") & ". satır silinmekten vazgeçildi.", vbInformation, "MUTLU"
End If

If soru = vbYes Then
Rows(Target.Row & ":" & Target.Row).Delete
Cancel = True

On Error Resume Next
For i = 2 To Sheets(1).Range("B65536").End(3).Row
If Not Rows(i).Hidden = True Then
st = st + 1
Cells(i, "a") = st
End If
Next

CreateObject("WScript.Shell").Popup MSTF & ". satır silindi.", 1, "MUTLU", vbInformation
End If

Application.ScreenUpdating = True

End Sub

 

[ASLAN7410]

Sayın Mustafa Bey, ellerinize sağlık çok teşekkür ediyorum, tam istediğim gibi çalışıyor.

Hayırlı geceler diliyorum.

 

[Mustafa MUTLU]

Sayın Mustafa Bey, ellerinize sağlık çok teşekkür ediyorum, tam istediğim gibi çalışıyor.

Hayırlı geceler diliyorum.

Hayırlı Geceler