Sil makrosuna ilave

[1Al2Ver]

Merhaba,

Sub Düğme1_Tıklat()
Dim sor
sor = MsgBox("Silmek istediğinizden emin misiniz?", vbQuestion + vbYesNo, "Silme İşlemi")
Select Case sor
Case vbYes
ActiveSheet.Range("A2:A100,S2:S9,B2:J100").ClearContents
End Select
End Sub

bu kodda değişiklik yapılarak, sayfa1'deki mevcut düğme ve tek bir tıklama ile,

sayfa2(genelhijyen)
sayfa3(görünüş)
sayfa4(kıvam)
sayfa5(lezzet)
sayfa6(....)
sayfa7(....)
sayfa8(....)
sayfa9(....) sayfalarındaki "A2:A100,S2:S9,B2:J100" aralığını sildirmek istiyorum,

Teşekkür ederim

 

[leumruk]

Selamlar,
Bu kodu deneyiniz.

Sub Sil()
Dim sor
sor = MsgBox("Silmek istediğinizden emin misiniz?", vbQuestion + vbYesNo, "Silme İşlemi")
Select Case sor
Case vbYes
For i = 2 To Sheets.Count
Sheets(i).Range("A2:A100,S2:S9,B2:J100").ClearContents
Next i
End Select
End Sub

 

[1Al2Ver]

Selamlar,
Bu kodu deneyiniz.

Sub Sil()
Dim sor
sor = MsgBox("Silmek istediğinizden emin misiniz?", vbQuestion + vbYesNo, "Silme İşlemi")
Select Case sor
Case vbYes
For i = 2 To Sheets.Count
Sheets(i).Range("A2:A100,S2:S9,B2:J100").ClearContents
Next i
End Select
End Sub

Merhaba,

Tüm sayfalarda hatta modüllerde denedim ama,

"Object doesn't support this property or method" uyarısı aldım,

Hata benden kaynaklanıyor olabilir mi ?

 

[leumruk]

Deneyip yolladım. Ekli dosyadaki butona tıklayarak kontrol edebilirsiniz. Deneme amacıyla sadece diğer sayfalardaki a sütunlarına veri girdim.

 

[1Al2Ver]

Deneyip yolladım. Ekli dosyadaki butona tıklayarak kontrol edebilirsiniz. Deneme amacıyla sadece diğer sayfalardaki a sütunlarına veri girdim.

Sayın leumruk merhaba,

Teşekkür ederim, kodda ve dosyanızda sorun yok, sorun bendeki dosyadaki sayfalarda ve modüllerde olan kodlarla ilgili olabilir, gerçi uyarı veriyor ama yine de silme işlemini yapıyor,

Zahmetler oldu, tekrar teşekkür ederim, bu haliyle idare edebilirim,

Saygılarımla.

 

[leumruk]

Sayfalarınızda sayfa kodu mu var? Private Sub Change gibi kodlar var mı?

 

[1Al2Ver]

Sayfamın bir tanesinde

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [b:b]) Is Nothing Then Exit Sub

diye başlayan bir kod

ThisWorkbook'ta

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ActiveSheet.OnDoubleClick = "isaretle"
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
ActiveSheet.OnDoubleClick = ""
End Sub

kodlarım var, ayrıca da modül1 ve modül2 de kodlarım var.

 

[leumruk]

Selamlar,
Kodları şununla değiştirip, bilgi verebilir misiniz?

Sub Sil()
Dim sor
sor = MsgBox("Silmek istediğinizden emin misiniz?", vbQuestion + vbYesNo, "Silme İşlemi")
Select Case sor
Case vbYes
Application.EnableEvents = False
For i = 2 To Sheets.Count
Sheets(i).Range("A2:A100,S2:S9,B2:J100").ClearContents
Next i
Application.EnableEvents = True
End Select
End Sub

Modülde kod olması sıkıntı çıkarmaz. Sorun Sayfa kodlarınızdan kaynaklanıyor. Hücreleri silme işlemi gerçekleşirken sayfa kodları da çalışmaya başlıyor ve sorun çıkıyor olmalı.

 

[1Al2Ver]

Merhaba,

Biraz uğraştım ama sonuç değişmedi,

En iyisi dosyayı ekleyim, sizide boşuna uğraştırmayayım,

Göz görünce daha kolay olur sanırım,

 

[leumruk]

Selamlar,
Farklı bir kod oluşturdum. Ötekinin sebebini çözemedim. Bu eklediğim işe yarıyor.

Sub Sil()
Application.ScreenUpdating = False
Dim sor
sor = MsgBox("Silmek istediğinizden emin misiniz?", vbQuestion + vbYesNo, "Silme İşlemi")
Select Case sor
Case vbYes
Application.EnableEvents = False
    Dim myArray() As Variant
    Dim i As Integer
    Dim j As Integer
    j = 0
    For i = 2 To Sheets.Count
        If Sheets(i).Visible = True Then
            ReDim Preserve myArray(j)
            myArray(j) = i
            j = j + 1
        End If
    Next i
    Sheets(myArray).Select
    Sheets(2).Range("A2:A100,S2:S9,B2:J100").Select
    Selection.ClearContents
    [A1].Select
    Sheets(1).Select
Application.EnableEvents = True
End Select
Application.ScreenUpdating = True
End Sub

 

[1Al2Ver]

Selamlar,
Farklı bir kod oluşturdum. Ötekinin sebebini çözemedim. Bu eklediğim işe yarıyor.

Sub Sil()
Application.ScreenUpdating = False
Dim sor
sor = MsgBox("Silmek istediğinizden emin misiniz?", vbQuestion + vbYesNo, "Silme İşlemi")
Select Case sor
Case vbYes
Application.EnableEvents = False
    Dim myArray() As Variant
    Dim i As Integer
    Dim j As Integer
    j = 0
    For i = 2 To Sheets.Count
        If Sheets(i).Visible = True Then
            ReDim Preserve myArray(j)
            myArray(j) = i
            j = j + 1
        End If
    Next i
    Sheets(myArray).Select
    Sheets(2).Range("A2:A100,S2:S9,B2:J100").Select
    Selection.ClearContents
    [A1].Select
    Sheets(1).Select
Application.EnableEvents = True
End Select
Application.ScreenUpdating = True
End Sub

Merhaba, mutlaka denemişsinizdir, ama benim enerjim tükendi bu saatte, kodu nereye kopyalayayım, bir iki deneme yaptım A1'lerdeki verileri sildi, bir yerde hatam var sanırım.

 

[leumruk]

Modüle2'ye kopyalayabilirsiniz. Ben de A1'i silmiyor. Dosyayı ekliyorum.

 

[1Al2Ver]

Modüle2'ye kopyalayabilirsiniz. Ben de A1'i silmiyor. Dosyayı ekliyorum.

Sayın leumruk merhaba,

Bu saate kadar uğraştınız, emek verdiniz, elinize sağlık ,öncelikle teşekkürlerimi kabul edin lütfen,

Garip ama benim dosya çalışmadı, ben de sizin son yolladığınız üzerinden işlem yaptım, belki de makinamda sorun çıkıyordur, sonra bir ara irdelerim,

Tekrar teşekkür ediyorum ve iyi sabahlar diliyorum,

Saygılarımla.

 

[leumruk]

Rica ederim. İlginç bir durum gerçekten. Size de hayırlı sabahlar. Neden kaynaklandığını ben de marak ettim. Çözdüğünüzde bilgi verirseniz sevinirim.