Protection de plusieurs feuilles par macro + autorisation de modification

Bonjour,

J'ai 2 soucis

J'ai un classeur avec plusieurs feuilles identiques (une par commercial) que j'ai protégées grâce à une macro.

Cependant, j'aimerais que les utilisateurs puissent changer le format des cellules verrouillées, faire des tris et utiliser les filtres.

Étant novice en VBA, je n'arrive pas à le faire.

De plus, le mot de passe pour déprotéger ne sert à rien, même si j'en mets un faux, la protection s'enlève...

Voici ma macro:

Sub Vérrouiller()
' Protection automatique de toutes les feuilles d'un classeur
Dim nombre As Integer
nombre = ActiveWorkbook.Sheets.Count
Application.ScreenUpdating = False
For i = 1 To nombre
Worksheets(i).Protect
End Sub

Sub Déverrouiller()

Dim Feuil As Worksheet
For Each Feuil In Sheets
Feuil.Unprotect PassWord:="COMPTA"
Next Feuil
Dim PassWord As String

PassWord = InputBox(" Entrez le mot de passe ", " Déverrouillage de l'ensemble des Feuilles")
If PassWord = "COMPTA" Then
ActiveSheet.Unprotect "COMPTA"
Else
MsgBox "Erreur Mot de Passe !", , "Attention"
End If

End Sub

Merci d'avance pour votre aide

Bonjour, avec ceci ?

Sub Deverouiller()
mdp = InputBox("Entrer le mot de passe :", "Déverrouillage de l'ensemble des Feuilles")
  If mdp <> "COMPTA" Then
  MsgBox "Erreur Mot de Passe ! Attention", vbCritical + vbOKOnly, "Erreur"
    Exit Sub
  End If
   ActiveSheet.Unprotect "COMPTA"
End Sub

Bonjour,

Merci beaucoup, ça fonctionne lorsque le mdp est faux mais par contre lorsqu'il est juste ça me fait une erreur 1004

Est-ce que quelqu'un saurait également comment je peux autoriser les utilisateurs à changer le format des cellules verrouillées, faire des tris et utiliser les filtres,svp?

Merci pour votre aide :)

Bonjour,
Essaie ainsi :

Option Explicit

Dim ws As Worksheet
Const PWD As String = "COMPTA"

Sub ProtectWorksheets()
    For Each ws In ActiveWorkbook.Worksheets
        ws.Protect PassWord:=PWD, _
                   userinterfaceonly:=True, _
                   AllowFormattingCells:=True, _
                   AllowSorting:=True, _
                   AllowFiltering:=True, _
                   AllowUsingPivotTables:=True
    Next ws
End Sub

Sub UnprotectWorksheets()
Dim Answer As String
    Answer = InputBox("Entrez le mot de passe.", "Déverrouillage de l'ensemble des Feuilles")
    If Answer = PWD Then
        For Each ws In ActiveWorkbook.Worksheets
            ws.Unprotect PassWord:=PWD
        Next ws
    Else
        MsgBox "Erreur Mot de Passe !", 64, "Attention"
    End If
End Sub

Wah, un immense merci Jean-Eric, c'est parfait !!!

Excellente fin de journée à tous!