XL 2010 Evolution macro entre plusieurs feuilles

Re : Evolution macro entre plusieurs feuilles

Hello

ajoute ce bout de code en fin de macro

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

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

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

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")

Cliquez pour agrandir...

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;😉;"")

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 😎