VBA sous excel : Utiliser l'offset pour un range sur plusieurs feuilles
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:
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:
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
