VBA Modification code

Bonjour le forum, je souhaiterais ajouter une "exclusion" dans un code qui m'a été fourni par Mafraise (je ne sais pas si je peux le contacter directement)

je voudrais ajouter l'exclusion: de la colonne "H" de la feuille "Catalogue"

Merci d'avance

Nonno

   Sub RemplaceExclure() 'Sauf colonne "C" dans feuil "Stock"
   ' Pour toutes les feuilles sauf les feuilles de la liste  Exclure
   If MsgBox("Modification1! Etes vous sûr?Avez vous oté la protection feuille? ", vbYesNo, "Confirmation") = vbYes Then
If Range("F24,F27") <> "" Then
   Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
   Const S = ";"                 ' séparateur de la liste des feuilles à exclure
   Const Exclure = "Mouvement"   ' <- liste des feuilles à exclure - séparateur S
   Dim Feuil As Worksheet, Cel As Range, ValCherche As String, ValRemplace As String

   If Range("F27") <> "" Then
      ValCherche = Sheets("Mouvement").Range("F24")
      ValRemplace = Sheets("Mouvement").Range("F27")
      On Error Resume Next
      For Each Feuil In Worksheets
         If InStr(1, S & Exclure & S, S & Feuil.Name & S, vbTextCompare) = 0 Then
            If LCase(Feuil.Name) = LCase("stock") Then
               For Each Cel In Feuil.UsedRange
                  If Cel.Column <> [c1].Column Then
                     If Cel.Value Like ValCherche Then Cel.Value = ValRemplace
                  End If
               Next Cel
            Else
               For Each Cel In Feuil.UsedRange
                  If Cel.Value Like ValCherche Then Cel.Value = ValRemplace
               Next Cel
            End If
         End If
      Next Feuil
      Range("F24").ClearContents
      Range("F27").ClearContents
   Else
       MsgBox "Modifier - Remplacé par ?"
   End If
   End If
 Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If
End Sub

Bonjour,

Quand vous référez à un post précédent, ajoutez un lien afin qu'on comprenne plus facilement ce que vous vouliez Modification code

Si j'ai bien compris, la modification suivante devrait fonctionner :

Mais bon si vous voulez Exclure davantage de feuilles/plages spécifiques, il pourrait etre intéressant de revoir le code pour le rendre plus "flexible", mafraise vous a fourni quelque chose de très efficace mais assez "statique". De fait n'hésitez pas, (si vous le savez déjà), quand vous faites une demande, à etre précis sur ce genre de conditions. Pour gérer 1 cas particulier ou 10 cas particuliers on ne programme pas de la meme façon.

Sub RemplaceExclure()                            'Sauf colonne "C" dans feuil "Stock"
  ' Pour toutes les feuilles sauf les feuilles de la liste  Exclure
  If MsgBox("Modification1! Etes vous sûr?Avez vous oté la protection feuille? ", vbYesNo, "Confirmation") = vbYes Then
    If Range("F24,F27") <> "" Then
      Application.Calculation = xlCalculationManual
      Application.ScreenUpdating = False
      Const S = ";"                              ' séparateur de la liste des feuilles à exclure
      Const Exclure = "Mouvement;Catalogue"                ' <- liste des feuilles à exclure - séparateur S
      Dim Feuil As Worksheet, Cel As Range, ValCherche As String, ValRemplace As String

      If Range("F27") <> "" Then
        ValCherche = Sheets("Mouvement").Range("F24")
        ValRemplace = Sheets("Mouvement").Range("F27")
        On Error Resume Next
        For Each Feuil In Worksheets
          If InStr(1, S & Exclure & S, S & Feuil.Name & S, vbTextCompare) = 0 Then
            If LCase(Feuil.Name) = LCase("stock") Then
              For Each Cel In Feuil.UsedRange
                If Cel.Column <> [c1].Column Then
                  If Cel.Value Like ValCherche Then Cel.Value = ValRemplace
                End If
              Next Cel
            ElseIf LCase(Feuil.Name) = LCase("Catalogue") Then
              For Each Cel In Feuil.UsedRange
                If Cel.Column <> [H1].Column Then
                  If Cel.Value Like ValCherche Then Cel.Value = ValRemplace
                End If
              Next Cel
            Else
              For Each Cel In Feuil.UsedRange
                If Cel.Value Like ValCherche Then Cel.Value = ValRemplace
              Next Cel
            End If
          End If
        Next Feuil
        Range("F24").ClearContents
        Range("F27").ClearContents
      Else
        MsgBox "Modifier - Remplacé par ?"
      End If
    End If
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
  End If
End Sub

Bonsoir saboh12617

Merci cala fonctionne parfaitement.

Bonne soirée et merci encore pour la modification et les conseils.

Cordialement

Nonno