Can I lock every sheet?

[Tarqs]

I'm using the below code but i need to lock every new sheet that it creates?

If you could help it would be much appreciated.

Sub ExplodeTotal()
        ActiveSheet.PivotTables("PivotTable1").ShowPages PageField:="Supplier"
        Application.ScreenUpdating = False
End Sub

Tarqs

 

[MrKowz]

This is untested, but try:

Sub ExplodeTotal()
Dim shtcnt  As Long, _
    i       As Long
    
shtcnt = Sheets.Count
Application.ScreenUpdating = False

ActiveSheet.PivotTables("PivotTable1").ShowPages PageField:="Supplier"

For i = shtcnt + 1 To Sheets.Count
    Sheets(i).Protect
Next i

Application.ScreenUpdating = True
End Sub

 

[Tarqs]

MrKowz,

Thanks for taking the time.

Nearly works, but two things.

1. It locks all but the first sheet which is created.
2. Can I put a password into the code as currently clicking the unlock button from the ribbon will defeat it?

Tarqs

 

[MrKowz]

Try:

Sub ExplodeTotal()
Dim shtcnt  As Long, _
    i       As Long
    
shtcnt = Sheets.Count
Application.ScreenUpdating = False
ActiveSheet.PivotTables("PivotTable1").ShowPages PageField:="Supplier"
For i = [COLOR=red][B]shtcnt[/B][/COLOR] To Sheets.Count
    Sheets(i).Protect [COLOR=red][B]Password:=[/B][/COLOR][B][COLOR=red]"abc123[/COLOR][COLOR=red]"
[/B][/COLOR]Next i
Application.ScreenUpdating = True
End Sub

 

[Tarqs]

Perfect!

Thank you.

 

[Tarqs]

Mr Kowz,

Apologies but time to be cheeky! Now I have locked the outputs i need to resize the columns or you can't see all the data.

Do you no how to add the below into the code?

ws.Cells.EntireColumn.AutoFit

Tarqs

 

[MrKowz]

Try:

Sub ExplodeTotal()
Dim shtcnt  As Long, _
    i       As Long
    
shtcnt = Sheets.Count
Application.ScreenUpdating = False
ActiveSheet.PivotTables("PivotTable1").ShowPages PageField:="Supplier"
For i = shtcnt To Sheets.Count
    Sheets(i).Cells.EntireColumn.AutoFit
    Sheets(i).Protect Password:="abc123"
Next i
Application.ScreenUpdating = True
End Sub

 

[Tarqs]

Absolute Legend !