Problème de protection lors de copie avec macro Résolu/Fermé

Question

Bonjour à tous!

J'ai un petit problème avec une macro qui se lance en double-cliquant sur une cellule de la colonne "C" de ma feuille générale (Coordonnées). 

Cette macro sert à modifier la valeur de la cellule sélectionné. Elle recherche la valeur de la cellule avant modification(original) dans les autres feuilles de mon fichier et lorsqu'elle la trouve, elle la remplace par la nouvelle valeur entrée dans l'InputBox.

Mon fichier contient 1 feuille générale et 4 autres feuilles pour chacun de mes types de sondages qui se classe selon la première lettre du sondage.

Mon problème est que mes feuilles sont toutes protégés! Donc, quand il veux remplacer la valeur dans la bonne feuille, ça ne fonctionne pas. 

J'ai essayé d'ajouter la fonction Activesheet.Unprotect à plusieurs endroit mais sans succès pour le moment, parce que ça déprotège ma feuille "Coordonnées" et non pas une des autres feuilles.

Voici mon code:

Private dlig As Long
Private PL As Range
Option Explicit
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim nvalue As String
Dim NewVal As Variant
Dim f As Worksheet
Dim valueRange As Range
Dim Cpt As Integer

Application.ScreenUpdating = False

nvalue = ActiveCell.Value

If Not Intersect(Target, Range("c5:c" & [a1048576].End(xlUp).Row + 1)) Is Nothing Then
        
    If MsgBox("Voulez-vous mofifier le numéro de ce sondage?", _
        vbYesNo + vbQuestion, "MODIFER") = vbYes Then
        
        NewVal = UCase(InputBox("Nouveau numéro de sondage?", "MODIFICATION DE NUMÉRO"))
        
        If NewVal = "" Then
            ActiveCell.Offset(-1, 0).Select
            Exit Sub
        Else
            ActiveCell = NewVal
        End If
        
            If InStr(1, nvalue, "C") = 1 Or InStr(1, nvalue, "M") = 1 Then
                Set valueRange = Sheets("CPTU").Columns(1)
                                
            ElseIf InStr(1, nvalue, "F") = 1 Then
                Set valueRange = Sheets("FORAGE").Columns(1)
                
            ElseIf InStr(1, nvalue, "Z") = 1 Or InStr(1, nvalue, "FZ") = 1 Then
                Set valueRange = Sheets("Piézomètres").Columns(2)

ElseIf InStr(1, nvalue, "I") = 1 Then
                Set valueRange = Sheets("Inclinomètres").Columns(2)
                
            Else
                Set valueRange = Nothing
                MsgBox "La valeur n'a pas été trouvé dans les autres feuilles! Mettre à jours les feuillets sur la page d'accueil!", vbCritical
            End If
            
                If Not valueRange Is Nothing Then
                    valueRange.Replace nvalue, NewVal, lookat:=xlWhole, searchorder:=xlByColumns
                End If
                                   
        If NewVal <> nvalue Then
        MsgBox "N'oubliez pas de changer le numéro dans la colonne ABRÉVIATION!", vbExclamation, "IMPORTANT"
        ActiveCell.Offset(-1, 0).Select
        End If
        
    Else
    
    ActiveCell.Offset(-1, 0).Select
    
    End If
    
End If

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Voici mon fichier:
https://www.cjoint.com/?0DipTOn2Z5r

Pouvez vous m'aider sur celle là?!

Merci!

cs_Le Pivert · Answer

Bonjour,

Voir ceci:
 http://www.excelabo.net/excel/protection_multi_feuilles

Problème de protection lors de copie avec macro

1 réponse

Discussions similaires