Soru Excel sayfası temizle

[sebahattin]

selamun aleyküm Çok kiymetlı Excel Web çalışanları Kurban Satıs Formu olan sayfamda B sütunu olan hücrelerden 7 satır olmak üzere B7 den başlamak üzere ilk 3 satır içeriği Temizlenecek ve diğer 4 satır içeriği ve formül silinmeyecek yanı b7,b8,b9 içerik temizlenecek diğer b10,b11.b12,b13 formül silinmeyecek aynı zamanda D71182,F7:F1182,H7:H1182,I7:I1182,J7:J1182,K7:K1182,O7:O1182,Q7:Q1182 satırları silinecek ve aynı zamanda Kasa Etiket sayfasından silinecek Kurban Satıs Formu olan sayfanın ve Kasa Etiket olan sayfanın koruma şifresi "durusu" sayfa temizleme Şifresi 2025 olacak ve kullanıcıya sayfa temizleme sifresi degistırme imkanı olursa daha güzel olur bu konuda cevap veeceginizi umarak sizleri ALLAH'a emanet ediyorum

 

[KuTuKa]

Sub Kurban_Satıs_Temizle_Tam_Sutunlar()
Dim ws As Worksheet
Dim kullaniciSifre As String
Dim i As Long
Dim sonSatir As Long
Dim hucre As Range
Dim adresler As Variant
Dim j As Long

Set ws = ThisWorkbook.Sheets("Kurban Satıs Formu")

' Kullanıcı şifresi
kullaniciSifre = InputBox("Sayfa içeriğini temizlemek için şifreyi girin:", "Şifre Girişi")
If kullaniciSifre <> "2025" Then
MsgBox "Hatalı şifre! İşlem iptal edildi.", vbExclamation
Exit Sub
End If

' Sayfa korumasını kaldır
ws.Unprotect Password:="durusu"
Application.ScreenUpdating = False

sonSatir = 1182

' B sütunu: 7'şer satırda ilk 3 satırı temizle
For i = 7 To sonSatir Step 7
For Each hucre In ws.Range("B" & i & ":B" & i + 2)
On Error Resume Next
hucre.MergeArea.ClearContents
On Error GoTo 0
Next hucre
Next i

' D, F, H, J, L, N, P, R, T sütunlarının 7–1182 aralığını tamamen temizle
adresler = Array("D71182", "I7:I1182", "K7:K1182", "M7:M1182", "F7:F1182", "H7:H1182", "I7:I1182", "Q7:Q1182", "O7:O1182", "J7:J1182", _
"L7:L1182", "P71182", "R7:R1182")

For j = LBound(adresler) To UBound(adresler)
On Error Resume Next
ws.Range(adresler(j)).MergeArea.ClearContents
ws.Range(adresler(j)).ClearContents
On Error GoTo 0
Next j

' Sayfayı tekrar koru
ws.Protect Password:="durusu", UserInterfaceOnly:=True

Application.ScreenUpdating = True
MsgBox "Tüm sütunlar başarıyla temizlendi.", vbInformation
End Sub