Copy a protected sheet in a shared workbook

[Firesword]

Hi All

I have a protected sheet in a shared workbook that I need to copy but my code will not copy the sheet while it's Shared. It works fine if I un-share the workbook. Is there a way to do this without un-sharing the workbook?

Sheet 20 will holds what the user is allowed to see/access.

The code checks to see if the user has access, then checks to see if there is a sheet with their name on it. If they currently don't have a sheet the code copies the master (code name sheet7) and renames it.

Any help would be great.

Thanks

Simon

Sub CreateAF27()
        
Dim lUserRow, lAF27Col As Long
Dim strUser As String
Dim wsSheetTest As Worksheet

    strUser = Application.UserName
    lUserRow = Sheet20.Range("A:A").Find(strUser, searchorder:=xlByColumns, searchdirection:=xlPrevious, lookat:=xlWhole).Row
    lAF27Col = Sheet20.Range("2:2").Find("AF27 - UserInput", searchorder:=xlByColumns, searchdirection:=xlPrevious, lookat:=xlWhole).Column
    
    If Sheet20.Cells(lUserRow, lAF27Col) = "Yes" Then
        On Error Resume Next
        Set wsSheetTest = Sheets("AF27 - " & strUserID)
        On Error GoTo 0
            If Not wsSheetTest Is Nothing Then
            Else
                Sheet7.Copy before:=Sheets(1)
                ActiveSheet.Name = "AF27 - " & strUserID
            End If
    End If

End Sub

 

[Firesword]

Sorry I have another issue as well.

If on sheet20 cell is <> "Yes", I'd then want to delete the sheet. again it works if the sheet is not shared but will not work when shared.

Sub CheckUserAccess()

Dim ws As Worksheet
Dim lUserRow, wsCol, lAF27Col As Long
Dim strUser As String

    strUser = Application.UserName
    lUserRow = Sheet20.Range("A:A").Find(strUser, searchorder:=xlByColumns, searchdirection:=xlPrevious, lookat:=xlWhole).Row
    wsCol = Sheet20.Range("2:2").Find(ch, searchorder:=xlByColumns, searchdirection:=xlPrevious, lookat:=xlWhole).Column
    lAF27Col = Sheet20.Range("2:2").Find("AF27 - UserInput", searchorder:=xlByColumns, searchdirection:=xlPrevious, lookat:=xlWhole).Column

                If ws.Name = "AF27 - Master" Then
                       Sheet20.Cells(lUserRow, wsCol) = "Yes"
                       ws.Visible = xlSheetVisible
                       ws.Move before:=Sheets(2)
                       Application.GoTo Reference:=ws.Range("A1")
                       Application.GoTo Reference:=ws.Range("B12")
                       Application.GoTo Reference:=ws.Range("I3")
                ElseIf ws.Name = "AF27 - " & strUserID Then
                       If Sheet20.Cells(lUserRow, lAF27Col) = "Yes" Then
                       ws.Visible = xlSheetVisible
                           ws.Move before:=Sheets(1)
                           Application.GoTo Reference:=ws.Range("B10")
                           Application.GoTo Reference:=ws.Range("A1")
                           Application.GoTo Reference:=ws.Range("I3")
                        Else
                           ws.Visible = xlSheetVisible
                           ws.Delete
                        End If
                End If