Belirli alandaki satırların silinmesi

[Arthassss]

Seçili hücrenin bulunduğu satırı silmek için kullandığım alttaki kodun, ilk 6 satırda bir hücre seçiliyse uyarı mesajı verip kapanmasını sağlayabilirmiyiz.

Sub SATIRSİL()
ActiveCell.Rows("1:1").EntireRow.Select
ActiveCell.Offset(0, 0).Range("A1:A2").Activate
Selection.Delete Shift:=xlUp
End Sub

Edit:makronun önüne " If Intersect(ActiveCell, [A7:Z24444]) Is Nothing Then Exit Sub
Cancel = True" kodunu yazarak alan belirlemeyi çözdüm ama uyarı mesajı vermesi konusunda hala yardıma ihtiyaç var.

 

[hsayar]

bu durumda 7. den önceki aralıka iken çık demiş oluyorsunuz illa hata mesajı istiyorum diyorsanız;

If Intersect(ActiveCell, [A7:Z24444]) Is Nothing Then
msgbox "tanımlı alanın haricinde seçim yaptınız",16
Exit Sub
end if

diyebilirisniz belli bir süre sonra canınızı sıkacağına eminim.

 

[Arthassss]

Alakanız için teşekkür ederim tam olarak istediğim oldu.
Birde silmesini istediğimiz A7:Z24444 aralığı içerisinde 1 adet benzersiz kırmızı renkli hücre var, bu hücrenin bulunduğu satırında silinmesini engellememiz mümkünmüdür.
Canımı sıkmayacağından emin olabilirsiniz.

 

[hsayar]

örnek dosya eklerseniz daha iyi olur ancak;
If Intersect(ActiveCell, [A7:Z24444]) Is Nothing Then
msgbox "tanımlı alanın haricinde seçim yaptınız",16
Exit Sub
if target.interior.colorindex = 3 then exit sub


olabilir.

 

[Arthassss]

Örnek dosya ekliyorum.

 

[Arthassss]

Son verdiğiniz kod malesef çalışmadı.

 

[hsayar]

eğer p kolonun dışındaki kırmızı satırlarıda silecekseniz kırmızı satırı siliniz.

Sub SATIRSİL()
On Error Resume Next
If Intersect(ActiveCell, [A7:BB65536]) Is Nothing Then
  CreateObject("WScript.Shell").Popup "BU SATIRI SİLEMEZSİNİZ." & Chr(10) & " " & Chr(10) & "BU MESAJ KUTUSU 2 SANİYE" & Chr(10) & " " & Chr(10) & "İÇERİSİNDE KENDİNİ KAPATACAKTIR.", 1, "UYARI"
  Exit Sub
End If

'iF ActiveRow
With ActiveCell
  If .Interior.ColorIndex = 3 [B][COLOR=Red]And .Column = 16[/COLOR][/B] Then
    CreateObject("WScript.Shell").Popup "BU SATIRI SİLEMEZSİNİZ." & Chr(10) & " " & Chr(10) & "BU MESAJ KUTUSU 2 SANİYE" & Chr(10) & " " & Chr(10) & "İÇERİSİNDE KENDİNİ KAPATACAKTIR.", 1, "UYARI"
    Exit Sub
  End If
  .Rows("1:1").EntireRow.Select
  .Offset(0, 0).Range("A1:A2").Activate
   Selection.Delete Shift:=xlUp
   Range("A7").Select
End With
End Sub

 

[Arthassss]

Alakanız için tekrar teşekkür ederim ama son verdiğiniz kod eğer kırmızı hücre seçiliyse silme işlemini iptal ediyor. Bu şekliyle doğru ama, benim istediğimse tam olarak kırmızı renkli hücrenin olduğu satırda bir hücre seçilirse o satırın silinememesi.
Yani kırmızı hücreyi değilde kırmızı rengin olduğu satırı seçince işlemin iptali.

 

[hsayar]

Alakanız için tekrar teşekkür ederim ama son verdiğiniz kod eğer kırmızı hücre seçiliyse silme işlemini iptal ediyor. Bu şekliyle doğru ama, benim istediğimse tam olarak kırmızı renkli hücrenin olduğu satırda bir hücre seçilirse o satırın silinememesi.
Yani kırmızı hücreyi değilde kırmızı rengin olduğu satırı seçince işlemin iptali.

Sub SATIRSİL()
On Error Resume Next
If Intersect(ActiveCell, [A7:BB65536]) Is Nothing Then
  CreateObject("WScript.Shell").Popup "BU SATIRI SİLEMEZSİNİZ." & Chr(10) & " " & Chr(10) & "BU MESAJ KUTUSU 2 SANİYE" & Chr(10) & " " & Chr(10) & "İÇERİSİNDE KENDİNİ KAPATACAKTIR.", 1, "UYARI"
  Exit Sub
End If

With ActiveCell
 [B][COLOR=Red] If Range("p" & .Row).Interior.ColorIndex = 3 Then[/COLOR][/B]
    CreateObject("WScript.Shell").Popup "BU SATIRI SİLEMEZSİNİZ." & Chr(10) & " " & Chr(10) & "BU MESAJ KUTUSU 2 SANİYE" & Chr(10) & " " & Chr(10) & "İÇERİSİNDE KENDİNİ KAPATACAKTIR.", 1, "UYARI"
    Exit Sub
  End If
  .Rows("1:1").EntireRow.Select
  .Offset(0, 0).Range("A1:A2").Activate
   Selection.Delete Shift:=xlUp
   Range("A7").Select
End With
End Sub

 

[Arthassss]

Çok teşekkür ediyorum. İstediğim gibi oldu.
Saygılar...