Hücrenin içine tick olayı gömmek

[gecebekcisi]

Tablo çok büyük şöyle bir tick olayı yaptım. aşğıda 150 tane hücre var. Hepsine kopyala yapıştır tek tek ugrasmak istemiyorum. Bunu hücrenin icine gömebilir miyiz? birde satırı sildiğim zaman gitmiyor kutucuklar. Bu yüzden hücrenin içine gömmem gerekiyor.

Teşekkürler

 

[muygun]

Merhaba;
Hücrenin içine gömülmesede farklı bir şekilde yapılabilir.
Eki inceleyin.
İyi çalışmalar.

Not: Kodlar alıntıdır.

 

[gecebekcisi]

benim excelde bir tane daha kod vardı. Onu da yapınca ikiside calısmadı Hata Nerede? Ekte de orjinalini gönderiyorum..

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [E:E]) Is Nothing Then Exit Sub
If Target = "Yok" Then
Cells(Target.Row, 7).Value = ""
Cells(Target.Row, 8).Value = ""
Cells(Target.Row, 9).Value = ""
Cells(Target.Row, 10).Value = ""
ElseIf Target = "2+7" Or Target = "2+2" Then
Cells(Target.Row, 7).Value = ""
Cells(Target.Row, 8).Value = ""
ElseIf Target = "-" Then
Cells(Target.Row, 9).Value = ""
Cells(Target.Row, 10).Value = ""
End If
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B3:B300")) Is Nothing Then
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Else
Target = vbNullString
End If
End If

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("d3:d300")) Is Nothing Then
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Else
Target = vbNullString
End If
End If

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("f3:f300")) Is Nothing Then
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Else
Target = vbNullString
End If
End If

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("h3:h300")) Is Nothing Then
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Else
Target = vbNullString
End If
End If
End Sub

Çok teşekkürler..