Auto Copy Macro?

[Henry]

Hi,

I have an macro that would protect the sheet and allow insert/delete columns
and rows, as follow,

Sub Autpen()
With Worksheets("Sheet 1")
.Protect Password:="hi", userinterfaceonly:=True
.EnableOutlining = True
End With

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True,
AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True

End Sub

i would like to modify it so that when i duplicate "Sheet 1" to "Sheet 2",
"Sheet 3", Sheet 4".....and so on, the macro would still work on all sheets
that start with "Sheet", any idea?

Thanks

 

[Dave Peterson]

Option Explicit
Sub Autpen()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
If LCase(Left(wks.Name, 5)) = "sheet" Then
With wks
.Protect Password:="hi", userinterfaceonly:=True
.EnableOutlining = True
End With
End If
Next wks

End Sub

If you wanted all those other protection options:

Option Explicit
Sub Autpen()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
If LCase(Left(wks.Name, 5)) = "sheet" Then
With wks
.Protect Password:="hi", userinterfaceonly:=True, _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True,
_
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
.EnableOutlining = True
End With
End If
Next wks

End Sub

 

[Dave Peterson]

Watch out for line wrap on that second sample.

Option Explicit
Sub Autpen()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
If LCase(Left(wks.Name, 5)) = "sheet" Then
With wks
.Protect Password:="hi", userinterfaceonly:=True
.EnableOutlining = True
End With
End If
Next wks

End Sub

If you wanted all those other protection options:

Option Explicit
Sub Autpen()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
If LCase(Left(wks.Name, 5)) = "sheet" Then
With wks
.Protect Password:="hi", userinterfaceonly:=True, _
DrawingObjects:=False, Contents:=True, _
Scenarios:=False, AllowFormattingCells:=True, _
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowInsertingColumns:=True, AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True,
_
AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True, AllowUsingPivotTables:=True
.EnableOutlining = True
End With
End If
Next wks

End Sub