Birden çok sayfanın belirli aralıklarını makro ile silme

[cayaso]

Dosyada 1 den 20'ye 101 den 145'e ve 201 den 245 'e kadar 110 sayfa mevcut, sayfa isimleri rakamlardan 1,2,3 101,102,201,202 gibi rakamlardan oluşmakta. Bu sayfalara aylık olarak veriler girmekteyim. Her ay bütün sayfaların B5:H50 ile J6:J50 aralıklarını tek tek manuel olarak silmek zorunda kalıyorum. Acaba bu sayfaların belirtilen aralıklarını makro ile bir defada silmek mümkünmü?.

 

[bedersu]

Sayın cayaso,
Örnek bir dosya koyarsanız her zaman daha açıklayıcı olacaktır.Aşağıdaki kodlar işinize yarar umarım.

Sub sil()
For i = 1 To Sheets.Count
Sheets(i).Range("B5:H50").Clear
Sheets(i).Range("J6:J50").Clear
Next i
End Sub

 

[Necdet]

Merhaba,

Aşağıdaki kodları ThisWorkBook'un kod bölümüne kopyalayınız.
Herhangi bir sayfada herhangi bir hücreye Çift Tıklandığında kodlar çalışacaktır.

Sizin belirttiğiniz sayfa numaraları dışında silme işlemi yapmayacaktır.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    
    Dim Syf As Worksheet
    Dim Evt As String
    
    Evt = MsgBox("TÜM SAYFALARDA SİLME İŞLEMİ YAPILACAKTIR, EMİN MİSİNİZ?", vbYesNo, "SAYFA SİLME")
    If Evt = vbYes Then
        Application.ScreenUpdating = False
        For Each Syf In Worksheets
            If IsNumeric(Syf.Name) Then
                If (Syf.Name > 0 And Syf.Name < 21) Or _
                   (Syf.Name > 100 And Syf.Name < 146) Or _
                   (Syf.Name > 200 And Syf.Name < 246) Then Syf.Range("B5:H50,J6:J50").ClearContents
            End If
        Next Syf
        Application.ScreenUpdating = True
        MsgBox "Tüm Sayfalarda B5:H50 ve J6:J50 Aralığı Silinmiştir...", vbInformation, "N. YEŞERTENER"
    End If
    
End Sub