VBA: how to protect specific sheets if they exist?-CodePudding

Thank you in advance for everyone's help.

I have code that works on different files inside a looping, however, these files have tabs with different names. I would need to protect some tabs (which may or may not exist in the files).

It would be something like this:

Sub AtualizarCOFAGRO()


'this sets your template workbook/worksheet
Dim copyWB As Workbook
Dim copyWS As Worksheet
Dim rInfo As Range

Set copyWB = Workbooks("Atualização de COF")
Set copyWS = copyWB.Sheets("Cadastro COF")
Set rInfo = copyWS.Range(Cells(1, 1), Cells(copyWS.Range("A" & Rows.Count).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column)) 'copiar todas as linhas e colunas com valores do arquivo


'this creates a collection of all filenames to be processed
Dim loopFolder As String
Dim fileNm As Variant
Dim myFiles As New Collection


'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False

'''don't forget the backslash before the final double-quote below

loopFolder = "J:\Files\Dept Produtos\Testes Macro Simulador\Arquivos para atualização\"
fileNm = Dir(loopFolder & "*.xlsm")

Do While fileNm <> ""
myFiles.Add fileNm
         fileNm = Dir
     Loop
    
'this loops through all filenames and copies your copyWS to the beginning

Dim wb As Workbook
For Each fileNm In myFiles
    Set wb = Workbooks.Open(Filename:=(loopFolder & fileNm))
    wb.Unprotect "Senha453" 'desbloquear planilha
   
    wb.Sheets("infomacro").Range("B2").ClearContents
    wb.Sheets("Cadastro COF").Cells.Clear 'limpar toda planilha dos arquivos abertos no loop
    rInfo.Copy
    wb.Sheets("Cadastro COF").Range("A1").PasteSpecial xlPasteAll
    wb.Sheets("infomacro").Range("B2").Value = Date
    wb.Sheets("infomacro").Range("B2").NumberFormat = "dd/mm/yyyy"
    wb.Sheets("infomacro").Visible = False
    wb.Sheets("Cadastro COF").Visible = False
    
    Application.Calculation = xlCalculationAutomatic
    
     wb.Protect "Senha453" 'bloquear planilha

this is the part I can't solve:

the name of the sheet could Be "input dados" or "CDC" or "LEASING". I would like to protect if either of them exists, if not, the code resume to next line.

wb.Sheets("input dados").Protect "Senha453"
     **or**
wb.Sheets("LEASING").Protect "Senha453"
**or**
wb.Sheets("CDC").Protect "Senha453"

Then follows

    Calculate
    wb.Save
    
    
    Dim inf As Worksheet
    Dim name As String
    Dim savefolder As String
    
    Set inf = wb.Sheets("Cadastro COF")
    savefolder = "J:\Files\Dept Produtos\Testes Macro Simulador\Atualizados\"
    name = wb.Sheets("infomacro").Range("b3").Value
    
    wb.SaveAs Filename:=savefolder & name & ".xlsm"

    wb.Close


Next

Reset Macro Optimization Settings

Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = Trueele

End Sub

CodePudding user response：

If this is possible, you can simply use something like this:

On Error Resume Next
wb.Sheets("input dados").Protect "Senha453"
wb.Sheets("LEASING").Protect "Senha453"
wb.Sheets("CDC").Protect "Senha453"
On Error goto 0 'Or any other error management

If the worksheet exist, it will protect it. If not, it will simply move to the next line. You can check if the workbook actually exists, but this will take more time to run, so unless you actually need to know if it exists or not, the above code should do it. If you need to verify if it exist, it would be something like this:

dim ws as Worksheet
dim exist as Boolean
exist = False
For Each ws in wb.Worksheets
  If ws.Name= "NameYouWantToFind"
     exist = True
  End If
Next ws

After that, you could simply use another if with the exist as condition.

Let me know if it worked.