PDA

View Full Version : Clear contents in multiple range and multiple sheets



jammer6_9
08-21-2013, 05:41 AM
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
08-21-2013, 06:33 AM
please share worksheet

david000
08-21-2013, 08:33 AM
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