VBA Modifier contenu cellules

Bonjour le forum

Je souhaiterais modifier le contenu de cellules(selon critère), dans 3 feuilles différentes.

fichier joint

Merci d'avance

Nonno

Bonsoir,

une proposition :

Sub Remplace()
    Dim Feuil As Worksheet, Cel As Range, ValCherche As String, ValRemplace As String
    ValCherche = Sheets("Stock").Range("D2"): ValRemplace = Sheets("Stock").Range("E2")
    On Error Resume Next
    For Each Feuil In Sheets
        For Each Cel In Feuil.UsedRange
            If Cel Like ValCherche Then
                Cel.Value = ValRemplace
            End If
        Next Cel
    Next Feuil
End Sub

Attention, cela "scanne" toutes les feuilles et toutes les cellules de la plage utilisée sur ces feuilles. Le remplacement se fait pour une valeur exacte. J'ai mis une gestion d'erreur car le changement se fait également sur la liste de choix et cela engendre une erreur. Si vous connaissez vos différentes plage alors ceci ne sera pas nécessaire sur le code final.

@ bientôt

LouReeD

Bonsoir Nonno , LouReeD ,

Une autre macro qui utilise le fait que les tableaux sont des tableaux structurés. On ne cherche que dans la colonne de titre "Références" dans chacun des trois tableaux. Cliquez sur le bouton Hop !.

Le code est dans module1. Il est un tout petit peu commenté.

Sub Remplacer()
Dim Quoi$, Par$, ligne&, colonne&, n&, x

' Vérification des deux termes (terme à remplacer et terme de remplacement). Aucun ne doit ni vide
' ni composé exclusivement d'espaces.
Quoi = Sheets("Stock").[d2]: Par = Sheets("Stock").[e2]
If Trim(Quoi) = "" Or Trim(Par) = "" Then
   MsgBox "Soit le code à emplacer est vide soit le code de remplacement est vide !" & vbLf & _
      "Aucun remplacement ne sera tenté => Echec.", vbCritical
   Exit Sub
End If

' On ne remplace que si les deux termes sont différents
If LCase(Quoi) = LCase(Par) Then
   MsgBox "Les deux références sont les mêmes" & vbLf & "Aucun remplacement ne sera donc fait.", vbCritical
   Exit Sub
End If

' Boucles de remplacement
For Each x In Split("Stock;Source;Catalogue", ";")    ' pour chaque feuile concernée
   ' Numéro de colonne du tableau structuré dont le titre est "Références"
   colonne = Sheets(x).ListObjects(1).ListColumns("Références").Index
   ' Ligne de cette colonne ayant pour valeur Quoi (si la valeur qQuoi est absente alors on renvoie zéro)
   ligne = Application.IfError(Application.Match(Quoi, Sheets(x).ListObjects(1).ListColumns(colonne).DataBodyRange, 0), 0)
   Do While ligne > 0      ' Tant qu'il y a encore une valeur égale à Quoi (ligne >0)
      ' On incrémente le nombre n de remplacement et on remplace la valeur
      If ligne > 0 Then n = n + 1: Sheets(x).ListObjects(1).ListColumns(colonne).DataBodyRange(ligne) = Par
      ' On recherche la valeur Quoi suivante
      ligne = Application.IfError(Application.Match(Quoi, Sheets(x).ListObjects(1).ListColumns(colonne).DataBodyRange, 0), 0)
   Loop
Next x
   MsgBox Format(n, "#,##0") & " remplacement(s) effectué(s)", vbInformation
End Sub

...

SUPER!

Merci mafraise, merci LouReeD vos propositions me conviennent parfaitement.

Encore merci

Bonne soirée

Nonno

Bonjour,

Merci de votre retour et remerciement !

@ bientôt

LouReeD

Bonjour LouReed, j'ai renvoyé sur le forum le code que tu m'as fourni jeudi pour une modification, je suis désolé je ne savais pas que je pouvais continuer sur le "même fil", c'est mafraise qui m'en a informé.

Avec mes excuses

Bonne journée

Nonno