Tek Kod İle Birden Fazla Sayfadaki Verileri Silme

[smaeler]

Merhaba Arkadaşlar;

Sub Temizle_D1()
Dim Cevap As Integer
Mesaj = "Tablo Veriler Silinsin mi?"
Baslik = "Sil"
Cevap = MsgBox(Mesaj, vbYesNo + vbQuestion, Baslik)
If Cevap = vbYes Then
Range("D7:E20").ClearContents
Range("G7:H20").ClearContents
Range("J7:K20").ClearContents
Range("M7:N20").ClearContents
Range("P7:Q20").ClearContents
Range("S7:T20").ClearContents
Range("Y7:AC20").ClearContents
Range("P3: AC3").ClearContents
Range("D22:U24").ClearContents
Else
End If
End Sub

Şeklinde D1 İsimli sayfadaki belli hücreleri temizleme formülüm var. Bunu D1-D15 isimli aynı biçimdeki diğer 15 adet sayfalara da uygulamak istiyorum. Tek hamlede bu 15 sayfadaki belirli yerleri temizleme MAKROSU nasıl olur arkadaşlar? Yardımlarınızı Bekliyorum.

 

[Muzaffer Ali]

Merhaba.

Deneyiniz.

Sub Temizle()
    Dim Sayfa As Integer
    If MsgBox("Tablo Veriler Silinsin mi?", vbYesNo + vbQuestion, "Sil") = vbYes Then
        For Sayfa = 1 To 15
            Worksheets("D" & Sayfa).Range("D7:E20, G7:H20, J7:K20, M7:N20, P7:Q20, S7:T20, Y7:AC20, P3: AC3, D22:U24").ClearContents
        Next
    End If
End Sub

 

[veyselemre]

Sub Temizle_D1()
    Dim Cevap As Integer, Mesaj$, Baslik$, i As Byte
    Mesaj = "Tablo Veriler Silinsin mi?"
    Baslik = "Sil"
    Cevap = MsgBox(Mesaj, vbYesNo + vbQuestion, Baslik)
    If Cevap = vbYes Then
        For i = 1 To 15
            If Evaluate("ISREF('D" & i & "'!A1)") Then
                With Sheets("D" & i)
                    Union(.Range("D7:E20"), .Range("G7:H20"), .Range("J7:K20"), _
                          .Range("M7:N20"), .Range("P7:Q20"), .Range("S7:T20"), _
                          .Range("Y7:AC20"), .Range("P3: AC3"), .Range("D22:U24")).ClearContents
                End With
            End If
        Next i
    Else
        MsgBox "Çıkış yapıldı..."
    End If
End Sub

 

[muygun]

Merhaba;
Alternatif bir kod da benden

Sub sayfaları_temizle()
Application.ScreenUpdating = False
On Error Resume Next
Dim Cevap As Integer
Mesaj = "Tablo Veriler Silinsin mi?"
Baslik = "Sil"
Cevap = MsgBox(Mesaj, vbYesNo + vbQuestion, Baslik)
If Cevap = vbYes Then
For sayfa = 1 To Sheets.Count
If Sheets(sayfa).Name <> "Sayfa3" And Sheets(sayfa).Name <> "Sayfa1" Then 'silinmeyecek sayfaları burada belirtin
Set s2 = ThisWorkbook.Worksheets(Sheets(sayfa).Name)
s2.Range("D7:E20").ClearContents
s2.Range("G7:H20").ClearContents
s2.Range("J7:K20").ClearContents
s2.Range("M7:N20").ClearContents
s2.Range("P7:Q20").ClearContents
s2.Range("S7:T20").ClearContents
s2.Range("Y7:AC20").ClearContents
s2.Range("P3: AC3").ClearContents
s2.Range("D22:U24").ClearContents
End If
Next sayfa
End If
End Sub

İyi çalışmalar.

 

[smaeler]

Merhaba.

Deneyiniz.

Sub Temizle()
    Dim Sayfa As Integer
    If MsgBox("Tablo Veriler Silinsin mi?", vbYesNo + vbQuestion, "Sil") = vbYes Then
        For Sayfa = 1 To 15
            Worksheets("D" & Sayfa).Range("D7:E20, G7:H20, J7:K20, M7:N20, P7:Q20, S7:T20, Y7:AC20, P3: AC3, D22:U24").ClearContents
        Next
    End If
End Sub

Çok Teşekkür ederim. Kod Çalıştı ve tam istediğim gibi oldu. Kodun kısa ve kolay olması da ayrıca güzel.