Bonjour,

Je suis confronté depuis quelques jours à un problème dont il me manque sûrement la clé.

Tout d'abord, j'explique ce que je recherche :

Je possède une feuille qui contient des cellules colorisées selon un code de couleur précis définissant un ordre de préférence (ex : rouge =1, orange =2...).
Ces cellules contiennent un texte.
Chaque ligne est indépendante et correspond à un item (et chacune contient donc 5 cases colorisées avec un texte mais disposées de façon aléatoire).

Mon objectif est de lire le champ de cellule de chaque ligne et, selon la couleur, les copier et le coller dans une autre feuille où j'ai 5 cases qui attendent pour la première, le contenu de la cellule détectée en rouge, en 2, le contenu de la cellule détectée en orange, etc...

Cela pour chaque ligne.

Pour la partie détection couleur et copie vers une autre feuille (pour une ligne), cela fonctionne sans problème.

Mais pour une seule ligne.

Mon objectif est de faire une boucle qui incrémenterait le range (ligne par ligne) avec la même procédure. Pour cela, je pensais que l'offset serait idéal. MAis rien ne se passe comme prévu et je me retrouve coincé avec la sélection des feuilles (mon programme semble perdu et je ne sais pas où il cherche ni ce qu'il trouve).

Voici ma boucle basique de détection couleur et copie dans une cellule qui fonctionne bien (module).


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub Macro1()
    Dim Ws As Worksheet
    Dim C As Range
    
   

    Dim PlageACalculer As Range
    Dim CelluleCouleurReference As Range
    Dim dest As Range

  
    For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name = "Liste-officielle" Then GoTo sortie
    If Ws.Name = "recap3B" Then GoTo sortie
    If Ws.Name = "3eB" Then
    

    Set PlageACalculer = Range("3eB!f3:s3")
    Set dest = Range("recap3B!F3")
   
    Set CelluleCouleurReference = Range("3eB!C32") 'là ou se trouve ma couleur rouge
     
    For Each C In PlageACalculer
    
        If (C.Interior.ColorIndex = CelluleCouleurReference.Interior.ColorIndex) Then

       dest.Value = C.Value
        
        End If
     Next C
   
'---Emplacement du code suivant qui ne fonctionne pas (voir ci après). 
'PRECISION : J'ai laissé la première itération car je voulais contrôler que cela fonctionnait avant de tout faire disparaître par une routine commune à toutes les lignes d'un coup
'---FIN ZONE Emplacement du code suivant qui ne fonctionne pas . 

     End If
sortie:
     Next Ws
End Sub
Je me retrouve bien avec le texte de ma cellule rouge pour la ligne de la plageacalculer.
Mais incrémenter, cela ne marche plus...
Voici mon code offset qui ne fonctionne pas:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
     Set PlageACalculer = Range("f3:s3") ' j avais essayé avec référence de la feuille mais cela bloquait l offset alors j'ai essayé avec un with, sans succès...
     Set dest = Range("F3")
     For i = 1 To 28
 
 
    'With Sheets("3eB")
    PlageACalculer.Offset(i, 0).Select
    'End With
 
    'With Sheets("recap3B")
    dest.Offset(i, 0).Select
    'End With
 
    Set CelluleCouleurReference = Range("3eB!C32")
 
    For Each C In PlageACalculer
 
        If (C.Interior.ColorIndex = CelluleCouleurReference.Interior.ColorIndex) Then
 
       'MsgBox (C)
       dest.Sheets("recap3B").Value = C.Sheets("3eB").Value ' j ai essayé d'if=dentifier la feuille avec un sheets, mais rien n'y fait...
 
        End If
     Next C
     Next i

Quelqu'un pourrait il m'aider?
Où vais je devoir me résigner à copier ces cellules détectées dans une autre zone d'une même feuille pour ensuite le copier/coller en une fois?

Très cordialement,

Totor