Recopier les cellules colorées d'une colonne vers une autre (ordre aléatoire) ?

beoper

XLDnaute Junior
Bonjour,

J'ai 2 colonnes situées dans 2 onglets différents qui ont certaines cellules avec un texte identique.
J'ai ajouté des couleurs à la main (sans mise en forme conditionnelle) dans certaines cellules d'une seule colonne dans "Feuil1".
Comment recopier avec vba ces cellules colorées dans l'autre colonne de "Feuil2" sachant que l'ordre de la colonne est différent ?

cf. fichier joint

Merci d'avance ;)
 

Pièces jointes

  • copie_couleurs.xlsm
    9.9 KB · Affichages: 53
  • copie_couleurs.xlsm
    9.9 KB · Affichages: 52
  • copie_couleurs.xlsm
    9.9 KB · Affichages: 53

job75

XLDnaute Barbatruc
Re : Recopier les cellules colorées d'une colonne vers une autre (ordre aléatoire) ?

Bonjour beoper,

Code VBA à placer dans ThisWorkbook (Alt+F11) :

Code:
Option Explicit
Option Compare Text 'la casse est ignorée

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim t1, t2, i&, t, j&
With Feuil1 'CodeName de la feuille source
  If Sh.Name = .Name Then Exit Sub
  Application.ScreenUpdating = False
  t1 = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)(2))
  t2 = Sh.Range("A1", Sh.Range("A" & Sh.Rows.Count).End(xlUp)(2))
  Sh.Range("A" & Rows.Count).Interior.ColorIndex = xlNone 'RAZ
  For i = 2 To UBound(t2)
    t = t2(i, 1)
    For j = 2 To UBound(t1)
      If t1(j, 1) = t Then
        If .Cells(j, 1).Interior.ColorIndex <> xlNone Then
          Sh.Cells(i, 1).Interior.Color = .Cells(j, 1).Interior.Color
          Exit For
        End If
      End If
    Next
  Next
  Application.ScreenUpdating = True
End With
End Sub
La macro se lance quand on active une feuille.

L'utilisation des tableaux VBA t1 et t2 accélère l'exécution.

Fichier joint.

Edit 1 : j'ai ajouté Exit For
Edit 2 : bonjour Pierre :)

A+
 

Pièces jointes

  • copie_couleurs(1).xls
    70.5 KB · Affichages: 40
Dernière édition:

pierrejean

XLDnaute Barbatruc
Re : Recopier les cellules colorées d'une colonne vers une autre (ordre aléatoire) ?

Bonjour beoper

Salut Gerard Heureux de te croiser :D

Je l'ai fait , je le poste
 

Pièces jointes

  • copie_couleurs.xlsm
    21.7 KB · Affichages: 37
  • copie_couleurs.xlsm
    21.7 KB · Affichages: 44
  • copie_couleurs.xlsm
    21.7 KB · Affichages: 51

beoper

XLDnaute Junior
Re : Recopier les cellules colorées d'une colonne vers une autre (ordre aléatoire) ?

Bonjour à tous,

En essayant la solution de Gérard et en ajoutant une cellule colorée de "Feuil1" (Abricot en jaune) dont le texte n'existe pas en "Feuil2", j'obtiens une "erreur d'Excution 91".

Je joins le fichier modifié.

Merci d'avance ;)
 

Pièces jointes

  • copie_couleurs2.xlsm
    24.4 KB · Affichages: 37

pierrejean

XLDnaute Barbatruc
Re : Recopier les cellules colorées d'une colonne vers une autre (ordre aléatoire) ?

Re

Pas sur qu'il s'agisse de la solution de Gerard !!
En tout cas voici un correctif

Code:
Private Sub CommandButton1_Click()
For n = 1 To Sheets(Me.ComboBox1.Value).Range("A" & Rows.Count).End(xlUp).Row
   coul = Sheets(Me.ComboBox1.Value).Range("A" & n).Interior.Color
   If coul <> 16777215 Then
    Set x = Sheets(Me.ComboBox2.Value).Columns(1).Find(Sheets(Me.ComboBox1.Value).Range("A" & n), LookIn:=xlValues, lookat:=xlWhole)
    If Not x Is Nothing Then
     x.Interior.Color = coul
    End If
   End If
Next
Unload Me
End Sub
 

beoper

XLDnaute Junior
Re : Recopier les cellules colorées d'une colonne vers une autre (ordre aléatoire) ?

Re,

Oups ! Pardon Pierre. En effet c'était bien de votre solution dont je parlais.
En tous les cas, merci pour ces modifications qui fonctionnent à merveille. ;)

Avec mes excuses et encore mille mercis pour votre aide très précieuse. ;)

Bonne journée
 

Discussions similaires