CODEWITHSUNDEEP
vbaexcel
Willem
Willem

Reputation: 1

Copy an sheet and lock certain cells from editing

I have a workbook with VBA code which copies a template sheet but I want to protect certain cells from editing when copied. The template sheet is protected by the locked cells which needs to be locked, but some cells are for user input and should be unlocked.

I cant get it to lock the cells in the copied sheet.

Sub MyCopySheet()

    Dim myNewSheetName
    myNewSheetName = InputBox("Enter Today's Date")
    Worksheets.Add(After:=Worksheets("Home")).Name = myNewSheetName

    Sheets(Sheets.Count - 1).Activate
    Cells.Copy
    Sheets(myNewSheetName).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    Range("F5:F69").ClearContents
    Range("G5:G69").ClearContents
    Range("H5:H69").ClearContents
    Range("I5:I69").ClearContents
    Range("J5:J69").ClearContents
    Range("K5:K69").ClearContents
    Range("Q5:Q59").ClearContents
    Range("O5:O59").ClearContents
    Range("L5:L69").ClearContents
    Range("B23:B27").ClearContents
    Range("B59:B63").ClearContents
    Range("B32:B36").ClearContents
    Range("B78:B94").ClearContents
    Range("C78:C94").ClearContents
    Range("F78:F94").ClearContents
    Range("G78:G94").ClearContents
    Range("J78:J94").ClearContents
    Range("I78:I94").ClearContents
    Range("K78:K94").ClearContents
    Range("L78:L94").ClearContents
    Range("B50:B54").ClearContents
End Sub

Sub lockcells()
    Dim Rng
    Dim MyCell
    Set Rng = Range("A1:Q96")
    For Each MyCell In Rng
        If MyCell.Value = "" Then

        Else: ActiveSheet.Unprotect Password:="password"
            MyCell.Locked = True
            MyCell.FormulaHidden = False
            ActiveSheet.Protect Password:="password", UserInterFaceOnly:=True

        End If
    Next
End Sub

Basically all the cells with Range().ClearContent must be unlocked and the rest locked.

Upvotes: 0

Views: 397

Answers (1)

Foxfire And Burns And Burns
Foxfire And Burns And Burns

Reputation: 11988

Sub MyCopySheet()

    Dim myNewSheetName
    myNewSheetName = InputBox("Enter Today's Date")
    Worksheets.Add(After:=Worksheets("Home")).Name = myNewSheetName

    Sheets(Sheets.Count - 1).Activate
    Cells.Copy
    Sheets(myNewSheetName).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    'clear contents
    Range("P107,B23:B27,B32:B36,B50:B54,B59:B63,B78:C94,F78:G94,I78:L94,O5:O59,Q5:Q59,F5:L69").ClearContents
End Sub

I reduced your code to clear contents. And below, the code to unprotect cells from range where you cleared contents

Sub lockcells()
    Dim Rng
    Dim MyCell
    Set Rng = Range("A1:Q96")
    For Each MyCell In Rng
        If MyCell.Value = "" Then

        Else: ActiveSheet.Unprotect Password:="password"
            MyCell.Locked = True
            MyCell.FormulaHidden = False
            ActiveSheet.Protect Password:="password", UserInterFaceOnly:=True
        End If
    Next

    'now we unprotect the range we cleared contents
    Range("P107,B23:B27,B32:B36,B50:B54,B59:B63,B78:C94,F78:G94,I78:L94,O5:O59,Q5:Q59,F5:L69").Locked = False
End Sub

Upvotes: 0

Related Questions