XL 2010 Evolution macro entre plusieurs feuilles

[tourry]

bonjour à tous,

Grâce à vgendron et à pierrejean qui m'ont super aidé dans l'évolution de mon fichier, ce classeur avance à grands pas. Merci encore à eux 2 !

il me reste 1 point sur lequel je bloque toujours.

Exemple :
Actuellement si ma date en H9 (feuille Andalousie) se retrouve en feuille Seville, alors le contenu indiqué dans la cellule voisine de cette date en feuille Seville (STOP ou RQ) colore la cellule H9 en feuille Andalousie.
Le procédé fonctionne également pour les autres cellules avec les autres feuilles.

Là où je cale c'est pour l'ordre suivant :
Si ma date en H9 (feuille Andalousie) se retrouve en feuille Seville, alors le nombre indiqué dans la cellule voisine de cette date en feuille Seville (1,2,3 ....) s'indique réellement en cellule J9 en feuille Andalousie.

Merci d'avance à celui qui a la clef

 

[vgendron]

Re : Evolution macro entre plusieurs feuilles

Hello

ajoute ce bout de code en fin de macro

Set zone = Sheets("Andalousie").Range("H9:H16")
'pour chaque jour de la zone prédéfinie
For Each jour In zone
    'on récupère le nom de l'onglet dans lequel aller chercher l'info
    onglet = jour.Offset(0, 1)
   'permet de traiter le cas du dernier jour: sans nom
    If onglet <> "" Then
  'on cherche la position du jour
    With Sheets(onglet)
        Set c = .Range("A6:W36").Find(jour)
        If Not c Is Nothing Then
            'on récupère le numéro à coté
            allot = c.Offset(0, 1)
        End If
    End With
    'dans le tableau, on recopie le nombre (ou STOP. ou RQ: pas de test sur le contenu. pour l'instant ;-)
    jour.Offset(0, 2) = allot
    End If
Next jour

PS: tu dois modifier l'orthographe des noms de ville dans le tableau pour qu'ils soient strictement identiques au nom des onglets
Séville avec ou sans accent

 

[tourry]

Re : Evolution macro entre plusieurs feuilles

bonjour vgendron

Mon sauveur ... comme d'hab !
En plus j'ai de la chance nous sommes pourtant mardi

ton dernier code fonctionne du tonnerre, pour mes différentes feuilles.

J'ai juste le blocage pour le 1er cas de cellules qui ne se suivent pas : ("H9", "H10", "H15")

J'ai essayé :
Set zone = Sheets("Andalousie").Range(liste(i)) = ça ne fonctionne pas
J'ai essayé :
Set zone = Sheets("Andalousie").Range("H9", "H10", "H15") = ça ne fonctionne pas non plus

Je n'ai pas compris en fait comment saisir une consigne lorsque ça s'adresse à des cellules qui ne se suivent pas obligatoirement !


Pour le reste ça fonctionne impeccable ...

Sub Kaneuf()
liste = Array("H9", "H10", "H15")

For i = LBound(liste) To UBound(liste)
'MsgBox liste(i)
jour = Sheets("Andalousie").Range(liste(i))
Set c = Sheets("Seville").Range("A6:W36").Find(jour, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
If UCase(c.Offset(0, 1)) = "STOP" Then
Sheets("Andalousie").Range(liste(i)).Interior.ColorIndex = 3
ElseIf UCase(c.Offset(0, 1)) = "RQ" Then
Sheets("Andalousie").Range(liste(i)).Interior.ColorIndex = 45
Else
Sheets("Andalousie").Range(liste(i)).Interior.ColorIndex = xlNone
End If
End If
Next i


Set zone = Sheets("Andalousie").Range(liste(i))
For Each jour In zone
Seville = jour.Offset(0, 1)
If Seville <> "" Then
With Sheets(Seville)
Set c = .Range("A6:W36").Find(jour)
If Not c Is Nothing Then
allot = c.Offset(0, 1)
End If
End With
jour.Offset(0, 2) = allot
End If
Next jour


liste = Array("H11", "H12")

For i = LBound(liste) To UBound(liste)
'MsgBox liste(i)
jour = Sheets("Andalousie").Range(liste(i))
Set c = Sheets("Grenade").Range("A6:W36").Find(jour, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
If UCase(c.Offset(0, 1)) = "STOP" Then
Sheets("Andalousie").Range(liste(i)).Interior.ColorIndex = 3
ElseIf UCase(c.Offset(0, 1)) = "RQ" Then
Sheets("Andalousie").Range(liste(i)).Interior.ColorIndex = 45
Else
Sheets("Andalousie").Range(liste(i)).Interior.ColorIndex = xlNone
End If
End If
Next i

Set zone = Sheets("Andalousie").Range("H11", "H12")
For Each jour In zone
Grenade = jour.Offset(0, 1)
If Grenade <> "" Then
With Sheets(Grenade)
Set c = .Range("A6:W36").Find(jour)
If Not c Is Nothing Then
allot = c.Offset(0, 1)
End If
End With
jour.Offset(0, 2) = allot
End If
Next jour

liste = Array("H13")

For i = LBound(liste) To UBound(liste)
'MsgBox liste(i)
jour = Sheets("Andalousie").Range(liste(i))
Set c = Sheets("Mijas").Range("A6:W36").Find(jour, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
If UCase(c.Offset(0, 1)) = "STOP" Then
Sheets("Andalousie").Range(liste(i)).Interior.ColorIndex = 3
ElseIf UCase(c.Offset(0, 1)) = "RQ" Then
Sheets("Andalousie").Range(liste(i)).Interior.ColorIndex = 45
Else
Sheets("Andalousie").Range(liste(i)).Interior.ColorIndex = xlNone
End If
End If
Next i

Set zone = Sheets("Andalousie").Range("H13")
For Each jour In zone
Mijas = jour.Offset(0, 1)
If Mijas <> "" Then
With Sheets(Mijas)
Set c = .Range("A6:W36").Find(jour)
If Not c Is Nothing Then
allot = c.Offset(0, 1)
End If
End With
jour.Offset(0, 2) = allot
End If
Next jour

liste = Array("H14")

For i = LBound(liste) To UBound(liste)
'MsgBox liste(i)
jour = Sheets("Andalousie").Range(liste(i))
Set c = Sheets("Chiclana").Range("A6:W36").Find(jour, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
If UCase(c.Offset(0, 1)) = "STOP" Then
Sheets("Andalousie").Range(liste(i)).Interior.ColorIndex = 3
ElseIf UCase(c.Offset(0, 1)) = "RQ" Then
Sheets("Andalousie").Range(liste(i)).Interior.ColorIndex = 45
Else
Sheets("Andalousie").Range(liste(i)).Interior.ColorIndex = xlNone
End If
End If
Next i

Set zone = Sheets("Andalousie").Range("H14")
For Each jour In zone
Chiclana = jour.Offset(0, 1)
If Chiclana <> "" Then
With Sheets(Chiclana)
Set c = .Range("A6:W36").Find(jour)
If Not c Is Nothing Then
allot = c.Offset(0, 1)
End If
End With
jour.Offset(0, 2) = allot
End If
Next jour
End Sub

 

[Lolote83]

Re : Evolution macro entre plusieurs feuilles

Salut TOURRY, VGENDRON,
Le temps d'aller manger un morceau et voilà que VGendron est encore passé par là.
Je n'ai pas testé sa macro, mais j'ai fait un essai via formule.
Le résultat est ICI si j'ai bien compris la consigne
@+ Lolote83

 

[vgendron]

Re : Evolution macro entre plusieurs feuilles

Hello Lolote. bien vu la formule.
j'y avais songé aussi. mais je passais par des recherches, equiv pour trouver la date. alors que.. ta solution est bien plus simple ;-)

@tourry
Ha bon? on est déjà mardi? ;-) Mince.. suis encore de bonne humeur :-D

J'ai juste le blocage pour le 1er cas de cellules qui ne se suivent pas : ("H9", "H10", "H15")

je ne comprend pas pourquoi tu veux limiter les cellules sur lesquelles appliquer la formule..
est ce qu'il y a une condition supplémentaire? genre.. on va chercher la valeur uniquement pour la région Séville?

Dans ce cas.. la formule de Lolote deviendrait simplement
=SI(I9="Séville";DECALER(INDIRECT(I9 & "!A5");JOUR(H9);MOIS(H9)*2-1;;"")

 

[tourry]

Re : Evolution macro entre plusieurs feuilles

Salut Lolotte83

Génial ! ça fonctionne du tonnerre ....

Moi je dis BRAVO !! vous êtes des super fortiches ...

Un ENORME MERCI à pierrejean et à vgendron sans qui je n'aurai jamais pu aller plus avant dans ce classeur et UN CHAPEAU BAS en supplément à vgendron qui, même un mardi, a su rester sympa et dispo (mais c'est l'été alors il va être sympa tous les jours)

Un GRAND MERCI à Lolotte83 pour sa formule de la fin qui à déverrouillée mon blocage !

Je mets le classeur ainsi composé avec votre aide précieuse à tous les 3 sur le forum; il peut être de secours à d'autres ...

Je poursuis mon ouvrage; mission prochaine : ajouter des feuilles sur le même masque pour avoir plusieurs destinations dans le même classeur.

A bientôt et belle fête musicale à tous