VBA split workbook in to separate sheets and protect each sheet

[Novice125]

Hey,

Very new to VBA and I have a headache trying to figure this one out, which I'm hoping is actually easy (or can actually be done)

I'm splitting a workbook down and saving each sheet as a new workbook separately, which has worked fine. However I would like that each new workbook is protected when saved, so that they can only click in certain cells that I want them to. Can not figure it out for the life of me, so if someone is willing to help.. please save my sanity

Sub copysheet()
Dim xWs As Worksheet
Dim xPath As String
xPath = Application.ActiveWorkbook.Path & "\Fee Earner Reports"
Application.ScreenUpdating = False
Application.DisplayAlerts = False


For Each xWs In ThisWorkbook.Sheets



xWs.Copy
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
Application.ActiveWorkbook.SaveAs Filename:=xPath & " " & xWs.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True


Sheets("Instructions").Select


MsgBox ("Done.")


End Sub

 

[John_w]

By default, all the cells on a sheet are 'locked', however this has no effect until you protect the worksheet. The Locked property is shown on the Protection tab of the Format Cells dialogue:

To lock and protect only specific cells you must first 'unlock' all the cells on the sheet, then 'lock' the specific cells and protect the worksheet.

This macro locks B1:B15 on each sheet in its new workbook and protects the sheet with the password "Excel":

Public Sub Save_and_Protect_All_Sheets()

    Dim ws As Worksheet
    Dim path As String
    
    path = ActiveWorkbook.path & "\Fee Earner Reports"
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each ws In ThisWorkbook.Worksheets
        ws.Copy
        With ActiveSheet
            .UsedRange.Value = .UsedRange.Value
            .Cells.Locked = False
            .Range("B1:B15").Locked = True
            .Protect Password:="Excel"
        End With
        ActiveWorkbook.SaveAs Filename:=path & " " & ws.Name & ".xlsx"
        ActiveWorkbook.Close False
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Worksheets("Instructions").Select
    
    MsgBox "Done."

End Sub

 

[Novice125]

By default, all the cells on a sheet are 'locked', however this has no effect until you protect the worksheet. The Locked property is shown on the Protection tab of the Format Cells dialogue:

View attachment 65355
To lock and protect only specific cells you must first 'unlock' all the cells on the sheet, then 'lock' the specific cells and protect the worksheet.

This macro locks B1:B15 on each sheet in its new workbook and protects the sheet with the password "Excel":

Public Sub Save_and_Protect_All_Sheets()

    Dim ws As Worksheet
    Dim path As String
   
    path = ActiveWorkbook.path & "\Fee Earner Reports"
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    For Each ws In ThisWorkbook.Worksheets
        ws.Copy
        With ActiveSheet
            .UsedRange.Value = .UsedRange.Value
            .Cells.Locked = False
            .Range("B1:B15").Locked = True
            .Protect Password:="Excel"
        End With
        ActiveWorkbook.SaveAs Filename:=path & " " & ws.Name & ".xlsx"
        ActiveWorkbook.Close False
    Next
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    Worksheets("Instructions").Select
   
    MsgBox "Done."

End Sub

Thank you so much! Works like a dream