Microsoft 365 Si cellule sélectionner alors mettre de la couleur sur les autres cellules de même nom

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion niglo
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
niglo

niglo

XLDnaute Nouveau
Bonjour,

j'ai 3 tableaux dans une feuille, dans ces tableaux j'ai des noms qui sont identiques.
Ce que je souhaiterai c'est que lorsque je met une couleur sur un nom dans le tableau 1 le même nom qui se trouve dans les tableaux 2 et 3 soit mis avec une autre policy et remplissage.

Merci d'avance de votre aide, en espérant avoir été assez clair !

Bonne journée
 

Pièces jointes

Trier par date Trier par votes
JBARBE à dit:
Bonjour à tous toutes,
Peut-être ceci avec 2 manques chez toi je pense (abdelkrime et pascal)!
Regarde la pièce jointe 1033108

Bonne journée !
Cliquez pour agrandir...
ROOOOOOOh vous êtes trop fort !! c'est exactement ça !!
Si je peux abuser ...
comment faire pour annuler / reset, j'explique j'ai sélectionner la mauvaise ligne mais je me suis aperçue qu’après avoir fait "GO" , je change ma sélection avec une autres lignes et je refais "GO" malheureusement les anciens noms sont toujours en noir.

Merci Merci et encore Merci du temps que vous m'accordez !!
 
Vote positif 0 Vote négatif
Re,
Tout à bord un message s'affiche pour demander si l'on veut effacer ( pour plus de sécurité )
Dans ma macro et pour pouvoir l'exporter sur d'autre fichier il faut (un tout petit peu de notion VBA) :
-changer les Numéros des lignes et des colonnes présentent !
- Changer le nom de la feuille ( ici feuil1)
Je prépare la description dans la macro !
 

Pièces jointes

Vote positif 0 Vote négatif
Re,
Ne tenir compte que des lignes, colonnes et feuille en vert (jaune ici) dans la macro pour reporter dans un autre tableau avec des dimensions différentes !
VB: 
Option Explicit

Sub TEST()
Dim i As Long, j As Long, k As Long, l As Long
Application.ScreenUpdating = False
For i = 2 To 6 ' colonnes de 2 à 6 (B à F)
 For k = 5 To 7 ' lignes de 5 à 7
 If Cells(k, i).Interior.ColorIndex <> xlNone Then
For j = 2 To 6 ' colonnes de 2 à 6
  If Cells(k, i) = Cells(11, j) And Cells(11, j).Interior.ColorIndex = xlNone Then ' cellule ligne 11 colonne j (2 à 6)
  Cells(11, j).Interior.ColorIndex = 1 ' cellule ligne 11 colonne j (2 à 6)
  Cells(11, j).Font.ColorIndex = 2 ' cellule ligne 11 colonne j (2 à 6)
  End If
  If Cells(k, i) = Cells(12, j) And Cells(12, j).Interior.ColorIndex = xlNone Then ' cellule ligne 12 colonne j (2 à 6)
  Cells(12, j).Interior.ColorIndex = 1 ' cellule ligne 12 colonne j (2 à 6)
  Cells(12, j).Font.ColorIndex = 2 ' cellule ligne 12 colonne j (2 à 6)
  End If
  If Cells(k, i) = Cells(13, j) And Cells(13, j).Interior.ColorIndex = xlNone Then ' cellule ligne 13 colonne j (2 à 6)
  Cells(13, j).Interior.ColorIndex = 1 ' cellule ligne 13 colonne j (2 à 6)
  Cells(13, j).Font.ColorIndex = 2 ' cellule ligne 13 colonne j (2 à 6)
  End If
  If Cells(k, i) = Cells(16, j) And Cells(16, j).Interior.ColorIndex = xlNone Then ' cellule ligne 16 colonne j (2 à 6)
  Cells(16, j).Interior.ColorIndex = 1 ' cellule ligne 16 colonne j (2 à 6)
  Cells(16, j).Font.ColorIndex = 2 ' cellule ligne 16 colonne j (2 à 6)
  End If
  If Cells(k, i) = Cells(17, j) And Cells(17, j).Interior.ColorIndex = xlNone Then ' cellule ligne 17 colonne j (2 à 6)
  Cells(17, j).Interior.ColorIndex = 1 ' cellule ligne 17 colonne j (2 à 6)
  Cells(17, j).Font.ColorIndex = 2 ' cellule ligne 17 colonne j (2 à 6)
  End If
  If Cells(k, i) = Cells(18, j) And Cells(18, j).Interior.ColorIndex = xlNone Then ' cellule ligne 18 colonne j (2 à 6)
  Cells(18, j).Interior.ColorIndex = 1 ' cellule ligne 18 colonne j (2 à 6)
  Cells(18, j).Font.ColorIndex = 2 ' cellule ligne 18 colonne j (2 à 6)
  End If
 Next j
 End If
 Next k
 
 For l = 11 To 13 ' lignes de 11 à 13
 If Cells(l, i).Interior.ColorIndex <> xlNone Then
For j = 2 To 6 ' colonnes de 2 à 6 (B à F)
  If Cells(l, i) = Cells(11, j) And Cells(11, j).Interior.ColorIndex = xlNone Then ' cellule ligne 11 colonne j (2 à 6)
  Cells(11, j).Interior.ColorIndex = 1 ' cellule ligne 11 colonne j (2 à 6)
  Cells(11, j).Font.ColorIndex = 2 ' cellule ligne 11 colonne j (2 à 6)
  End If
  If Cells(l, i) = Cells(12, j) And Cells(12, j).Interior.ColorIndex = xlNone Then ' cellule ligne 12 colonne j (2 à 6)
  Cells(12, j).Interior.ColorIndex = 1 ' cellule ligne 12 colonne j (2 à 6)
  Cells(12, j).Font.ColorIndex = 2 ' cellule ligne 12 colonne j (2 à 6)
  End If
  If Cells(l, i) = Cells(13, j) And Cells(13, j).Interior.ColorIndex = xlNone Then ' cellule ligne 13 colonne j (2 à 6)
  Cells(13, j).Interior.ColorIndex = 1 ' cellule ligne 13 colonne j (2 à 6)
  Cells(13, j).Font.ColorIndex = 2 ' cellule ligne 13 colonne j (2 à 6)
  End If
  If Cells(l, i) = Cells(16, j) And Cells(16, j).Interior.ColorIndex = xlNone Then ' cellule ligne 16 colonne j (2 à 6)
  Cells(16, j).Interior.ColorIndex = 1 ' cellule ligne 16 colonne j (2 à 6)
  Cells(16, j).Font.ColorIndex = 2 ' cellule ligne 16 colonne j (2 à 6)
  End If
  If Cells(l, i) = Cells(17, j) And Cells(17, j).Interior.ColorIndex = xlNone Then ' cellule ligne 17 colonne j (2 à 6)
  Cells(17, j).Interior.ColorIndex = 1 ' cellule ligne 17 colonne j (2 à 6)
  Cells(17, j).Font.ColorIndex = 2 ' cellule ligne 17 colonne j (2 à 6)
  End If
  If Cells(l, i) = Cells(18, j) And Cells(18, j).Interior.ColorIndex = xlNone Then ' cellule ligne 18 colonne j (2 à 6)
  Cells(18, j).Interior.ColorIndex = 1 ' cellule ligne 18 colonne j (2 à 6)
  Cells(18, j).Font.ColorIndex = 2 ' cellule ligne 18 colonne j (2 à 6)
  End If
 Next j
 End If
 Next l
Next i
Application.ScreenUpdating = True
End Sub

Sub effacer()
Dim vReponse As String
vReponse = MsgBox("Voulez-vous effacer ?", vbYesNo + vbQuestion)
If vReponse = vbYes Then
Sheets("Feuil1").Range("B5:F18").Interior.ColorIndex = xlNone ' feuille 1 et cellules ( tableau B5-F18)
Sheets("Feuil1").Range("B5:F18").Font.ColorIndex = 1 ' feuille 1 et cellules ( tableau B5-F18)
Else
Exit Sub
End If
End Sub
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
JBARBE à dit:
Re,
Ne tenir compte que des lignes, colonnes et feuille en vert (jaune ici) dans la macro pour reporter dans un autre tableau avec des dimensions différentes !
VB: 
Option Explicit

Sub TEST()
Dim i As Long, j As Long, k As Long, l As Long
Application.ScreenUpdating = False
For i = 2 To 6 ' colonnes de 2 à 6 (B à F)
For k = 5 To 7 ' lignes de 5 à 7
If Cells(k, i).Interior.ColorIndex <> xlNone Then
For j = 2 To 6 ' colonnes de 2 à 6
  If Cells(k, i) = Cells(11, j) And Cells(11, j).Interior.ColorIndex = xlNone Then ' cellule ligne 11 colonne j (2 à 6)
  Cells(11, j).Interior.ColorIndex = 1 ' cellule ligne 11 colonne j (2 à 6)
  Cells(11, j).Font.ColorIndex = 2 ' cellule ligne 11 colonne j (2 à 6)
  End If
  If Cells(k, i) = Cells(12, j) And Cells(12, j).Interior.ColorIndex = xlNone Then ' cellule ligne 12 colonne j (2 à 6)
  Cells(12, j).Interior.ColorIndex = 1 ' cellule ligne 12 colonne j (2 à 6)
  Cells(12, j).Font.ColorIndex = 2 ' cellule ligne 12 colonne j (2 à 6)
  End If
  If Cells(k, i) = Cells(13, j) And Cells(13, j).Interior.ColorIndex = xlNone Then ' cellule ligne 13 colonne j (2 à 6)
  Cells(13, j).Interior.ColorIndex = 1 ' cellule ligne 13 colonne j (2 à 6)
  Cells(13, j).Font.ColorIndex = 2 ' cellule ligne 13 colonne j (2 à 6)
  End If
  If Cells(k, i) = Cells(16, j) And Cells(16, j).Interior.ColorIndex = xlNone Then ' cellule ligne 16 colonne j (2 à 6)
  Cells(16, j).Interior.ColorIndex = 1 ' cellule ligne 16 colonne j (2 à 6)
  Cells(16, j).Font.ColorIndex = 2 ' cellule ligne 16 colonne j (2 à 6)
  End If
  If Cells(k, i) = Cells(17, j) And Cells(17, j).Interior.ColorIndex = xlNone Then ' cellule ligne 17 colonne j (2 à 6)
  Cells(17, j).Interior.ColorIndex = 1 ' cellule ligne 17 colonne j (2 à 6)
  Cells(17, j).Font.ColorIndex = 2 ' cellule ligne 17 colonne j (2 à 6)
  End If
  If Cells(k, i) = Cells(18, j) And Cells(18, j).Interior.ColorIndex = xlNone Then ' cellule ligne 18 colonne j (2 à 6)
  Cells(18, j).Interior.ColorIndex = 1 ' cellule ligne 18 colonne j (2 à 6)
  Cells(18, j).Font.ColorIndex = 2 ' cellule ligne 18 colonne j (2 à 6)
  End If
Next j
End If
Next k

For l = 11 To 13 ' lignes de 11 à 13
If Cells(l, i).Interior.ColorIndex <> xlNone Then
For j = 2 To 6 ' colonnes de 2 à 6 (B à F)
  If Cells(l, i) = Cells(11, j) And Cells(11, j).Interior.ColorIndex = xlNone Then ' cellule ligne 11 colonne j (2 à 6)
  Cells(11, j).Interior.ColorIndex = 1 ' cellule ligne 11 colonne j (2 à 6)
  Cells(11, j).Font.ColorIndex = 2 ' cellule ligne 11 colonne j (2 à 6)
  End If
  If Cells(l, i) = Cells(12, j) And Cells(12, j).Interior.ColorIndex = xlNone Then ' cellule ligne 12 colonne j (2 à 6)
  Cells(12, j).Interior.ColorIndex = 1 ' cellule ligne 12 colonne j (2 à 6)
  Cells(12, j).Font.ColorIndex = 2 ' cellule ligne 12 colonne j (2 à 6)
  End If
  If Cells(l, i) = Cells(13, j) And Cells(13, j).Interior.ColorIndex = xlNone Then ' cellule ligne 13 colonne j (2 à 6)
  Cells(13, j).Interior.ColorIndex = 1 ' cellule ligne 13 colonne j (2 à 6)
  Cells(13, j).Font.ColorIndex = 2 ' cellule ligne 13 colonne j (2 à 6)
  End If
  If Cells(l, i) = Cells(16, j) And Cells(16, j).Interior.ColorIndex = xlNone Then ' cellule ligne 16 colonne j (2 à 6)
  Cells(16, j).Interior.ColorIndex = 1 ' cellule ligne 16 colonne j (2 à 6)
  Cells(16, j).Font.ColorIndex = 2 ' cellule ligne 16 colonne j (2 à 6)
  End If
  If Cells(l, i) = Cells(17, j) And Cells(17, j).Interior.ColorIndex = xlNone Then ' cellule ligne 17 colonne j (2 à 6)
  Cells(17, j).Interior.ColorIndex = 1 ' cellule ligne 17 colonne j (2 à 6)
  Cells(17, j).Font.ColorIndex = 2 ' cellule ligne 17 colonne j (2 à 6)
  End If
  If Cells(l, i) = Cells(18, j) And Cells(18, j).Interior.ColorIndex = xlNone Then ' cellule ligne 18 colonne j (2 à 6)
  Cells(18, j).Interior.ColorIndex = 1 ' cellule ligne 18 colonne j (2 à 6)
  Cells(18, j).Font.ColorIndex = 2 ' cellule ligne 18 colonne j (2 à 6)
  End If
Next j
End If
Next l
Next i
Application.ScreenUpdating = True
End Sub

Sub effacer()
Dim vReponse As String
vReponse = MsgBox("Voulez-vous effacer ?", vbYesNo + vbQuestion)
If vReponse = vbYes Then
Sheets("Feuil1").Range("B5:F18").Interior.ColorIndex = xlNone ' feuille 1 et cellules ( tableau B5-F18)
Sheets("Feuil1").Range("B5:F18").Font.ColorIndex = 1 ' feuille 1 et cellules ( tableau B5-F18)
Else
Exit Sub
End If
End Sub
Cliquez pour agrandir...

Merci c'est vraiment cool d'avoir pris du temps pour me repondre

Bonne soirée
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

B
  • Résolu(e)
XL 2021 compter les cellules de la même couleur
2 3
Réponses
36
Affichages
700
mapomme
mapomme
T
  • Question Question
Microsoft 365 Faire la somme de cellules d'une colonne ayant le même nom dans une autre colonne.
Réponses
6
Affichages
76
Thibox
T
M
  • Question Question
Autres Mettre en couleur des cellules depuis une date de début jusqu'a la date de fin
Réponses
10
Affichages
312
mcl
M
O
  • Résolu(e)
Microsoft 365 Effacer le contenu de cellules si une autre cellule est vide
Réponses
9
Affichages
280
Olihoes
O
C
  • Question Question
Microsoft 365 je cherche un code excel pour copier la couleur d'une cellule, à toutes les cellules qui ont la même valeur dans mon tableau.
Réponses
1
Affichages
169
sylvanu
sylvanu
D
  • Question Question
XL 2016 Une Zone de Liste pour plusieurs cellules.
Réponses
7
Affichages
241
duduche62
D
A
  • Résolu(e)
XL 2016 Suivant un double-clic sur une cellule, mettre une couleur sur autres cellules.
Réponses
2
Affichages
379
Al1_44
A
D
  • Question Question
XL 2021 Liste déroulante et RECHERCHEV
Réponses
5
Affichages
299
Dubuyz1
D
W
  • Question Question
Microsoft 365 Correspondance de mot dans une cellule
Réponses
3
Affichages
133
job75
job75
D
  • Question Question
XL 2019 Suppression doublons combinés entre deux cellules associées et présentation sous forme de tableau
Réponses
13
Affichages
221
alexga78
A
C
  • Question Question
Microsoft 365 Ajout de données dans tableau existant
Réponses
8
Affichages
118
chris
chris
Didier Quilghini
  • Résolu(e)
XL 2019 Définir un nom d'un champ lors d'une macro
2
Réponses
28
Affichages
1 K
vgendron
vgendron
T
  • Résolu(e)
Microsoft 365 Exporter les plages nommées vers un nouveau classeur - plage nommée invalide selon VBA
Réponses
2
Affichages
138
tnion
T
Calvus
  • Question Question
Microsoft 365 Recherche incomplète planning (problème de dates)
Réponses
13
Affichages
245
p56
p56
jeff1494
  • Question Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
377
jeff1494
jeff1494
O
  • Question Question
Autres recopie de cellules selon la date
Réponses
3
Affichages
151
olivier Clech
O
S
  • Question Question
XL 2019 Calculer dimanche de pâques puis insertion du 29 février
2
Réponses
26
Affichages
489
dysorthographie
dysorthographie
B
  • Question Question
Microsoft 365 Je souhaite que la cellule résultat soit vierge si les autres cellules sont vide.
Réponses
4
Affichages
431
blancolie
B
M
  • Résolu(e)
XL 2016 #REF ! et nom de cellule existant sur cellules nommées
2
Réponses
16
Affichages
982
Mak_tarmak
M
S
  • Résolu(e)
XL 2016 copier des données d'une feuille à une autre selon critères et protection de la feuille 1
Réponses
6
Affichages
509
steph_29120
S
Retour