Clear contents in multiple range and multiple sheets

[jammer6_9]

Why i keep on having a Run-time error 1004 "Cannot change a part of a merge cell" and besides I do not have any merge cell in the sheets instead of Data Validation? is this considered as merge cell?

Private Sub CommandButton1_Click()


Dim Ws As Worksheet, rMyRg As Range


Set rMyRg = Range("d1:d54,f1:q54")


 
For Each Ws In Worksheets
UnProtectActiveSheet
    Select Case Ws.Name
    Case "Macro_Settings", "Master", "TOC", "Summary"
         ' do nthing
    Case Else
    Application.ScreenUpdating = False
        rMyRg.ClearContents
    End Select
    Application.ScreenUpdating = True
Next Ws


ProtectActiveSheet


End Sub

[raj85]

please share worksheet

[david000]

Private Sub Co()
Dim Ws As Worksheet, rMyRg As Range
Set rMyRg = Range("d1:d54,f1:q54")
    
    
Call Protect_Unprotect_All 'toggle on/off
    
For Each Ws In Sheets(Array(Sheet1.Name, Sheet2.Name, Sheet3.Name))
    If Ws.ProtectContents = False Then
        rMyRg.ClearContents
    End If
Next Ws

Call Protect_Unprotect_All
    
  
    
End Sub

Sub Protect_Unprotect_All()
Dim wSheet As Worksheet
Dim Password As String * 3
Application.ScreenUpdating = False
Password = "xyz" ' your Password here or "" for no password
For Each wSheet In Worksheets
    With wSheet
        If .ProtectContents = True Then
            .Unprotect Password
        Else
            .Protect Password, _
             DrawingObjects:=True, _
             Contents:=True, _
             Scenarios:=True, _
             AllowSorting:=True, _
             AllowFormattingCells:=True, _
             AllowFiltering:=True, _
             AllowUsingPivotTables:=True
        End If
    End With
 Next wSheet
 Application.ScreenUpdating = True
End Sub