XL 2016 Ecrire dans deux cellules de feuilles différentes en même temps

[ReneDav14000]

Bonjour à tous,
J'ai bien avancé dans mon projet, cependant je suis freiné par 2 soucis que je n'arrive pas à résoudre et qui me bloquent.

1 - Lorsque je clique sur une date qui va ouvrir la feuille correspondant à la semaine, j'aimerai que l'on soit positionné directement sur la même date de la feuille (par ex : je clique sur le 18/01 semaine 3 alors dans la feuille 3 la cellule correspondant au 18/1 est sélectionnée.

2 - Si j'écris en AK27 de la feuille "Calendrier" alors le texte est copié dans la cellule du 9 janvier de la semaine correspondant (feuille "3" - cellule AP2).

Il n'y a pas de mot de passe dans le verrouillage des feuilles (pour l'instant)

Merci par avance pour vos suggestions ou solutions

 

[Deadpool_CC]

Bonjour,

t'as déjà fait presque tout le boulot

il faut juste récupérer la date cible et après avoir activer la bonne feuille, décaler la selection en fonction de la date:

Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim vCol, N_NEM$
Dim JourCible As Date
Dim ColOffset As Integer

    Application.ScreenUpdating = False
 
    If Not Intersect(Target(1, 1), [C5,K5,S5,AA5,AI5,AQ5,C14,K14,S14,AA14,AI14,AQ14]) Is Nothing Then
        [B24] = Target(1, 1)
     
    End If
JourCible = Target(1, 1).Value
vCol = Array(2, 10, 18, 26, 34, 42)
 
    If Target.Count > 1 Then Exit Sub
    If Target.Row >= 7 And Target.Row <= 21 Then
 
    ck = Target.Column Mod 53
 
    If Not IsError(Application.Match(ck, vCol, 0)) Then Exit Sub
 
    On Error Resume Next
    N_SEM = CStr(Application.IsoWeekNum(Target))
     
        Worksheets(N_SEM).Visible = True
        Worksheets(N_SEM).Activate
        ColOffset = Weekday(JourCible, vbMonday)
        ActiveSheet.Range("B2").Offset(0, (ColOffset - 1) * 8).Select
    Else
Exit Sub

 End If
 
    Application.ScreenUpdating = True
End Sub

ps : dans le Offset réalisé tu peux mettre la première valeur avec autre chose que 0 pour sélectionner la ligne d'un heure particulière par défaut => exemple avec 7 tu devrais tomber sur la ligne de 9H.

Voila pour le point 1
si j'ai le temps je regarderais le point 2 dans l'aprem.

A+

 

[Deadpool_CC]

RE ...
je n''ai pas bien compris ce que tu voulais faire au point 2.
Mais tu peux utiliser la même logique pour sélectionner ta cible et mettre à jour sa valeur.
après tu veux mettre à jour une cellule contenant une formule avec une valeur ??? D'où mon incompréhension

 

[ReneDav14000]

RE ...
je n''ai pas bien compris ce que tu voulais faire au point 2.
Mais tu peux utiliser la même logique pour sélectionner ta cible et mettre à jour sa valeur.
après tu veux mettre à jour une cellule contenant une formule avec une valeur ??? D'où mon incompréhension

Bonjour Deadpool,
Désolé d'avoir tardé à te répondre mais je suis un peu souffrant.
Merci beaucoup pour ton aide.
Pour le point 2. Lorsque j'écris un texte par exemple le 3 janvier dans l'agenda de la feuille "Calendrier", je souhaiterai une sorte de copier/coller vers la feuille N°1 (parce que semaine 1 et copier le texte écrit dans l'agenda au 3 janvier) peu importe l'endroit, l'idéal serait en début de journée, sur la ligne 6h00.
L'agenda de la feuille "Calendrier" va être effacée à chaque changement de mois, lorsque l'utilisateur cliquera sur un des mois du calendrier plus haut. Cela permet de garder une trace.
Je pourrais passer par une UF qui enregistrerai les données aux deux endroits mais cela va alourdir mon fichier.
Merci par avance

 

[ReneDav14000]

Bonjour,

t'as déjà fait presque tout le boulot

il faut juste récupérer la date cible et après avoir activer la bonne feuille, décaler la selection en fonction de la date:

Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim vCol, N_NEM$
Dim JourCible As Date
Dim ColOffset As Integer

    Application.ScreenUpdating = False
 
    If Not Intersect(Target(1, 1), [C5,K5,S5,AA5,AI5,AQ5,C14,K14,S14,AA14,AI14,AQ14]) Is Nothing Then
        [B24] = Target(1, 1)
    
    End If
JourCible = Target(1, 1).Value
vCol = Array(2, 10, 18, 26, 34, 42)
 
    If Target.Count > 1 Then Exit Sub
    If Target.Row >= 7 And Target.Row <= 21 Then
 
    ck = Target.Column Mod 53
 
    If Not IsError(Application.Match(ck, vCol, 0)) Then Exit Sub
 
    On Error Resume Next
    N_SEM = CStr(Application.IsoWeekNum(Target))
    
        Worksheets(N_SEM).Visible = True
        Worksheets(N_SEM).Activate
        ColOffset = Weekday(JourCible, vbMonday)
        ActiveSheet.Range("B2").Offset(0, (ColOffset - 1) * 8).Select
    Else
Exit Sub

 End If
 
    Application.ScreenUpdating = True
End Sub

Regarde la pièce jointe 1155292

ps : dans le Offset réalisé tu peux mettre la première valeur avec autre chose que 0 pour sélectionner la ligne d'un heure particulière par défaut => exemple avec 7 tu devrais tomber sur la ligne de 9H.

Voila pour le point 1
si j'ai le temps je regarderais le point 2 dans l'aprem.

A+

Merci beaucoup, le code fonctionne très bien. J'ai positionné l'offset à 1.

 

[Deadpool_CC]

Bonsoir,
Il m'est tombé une urgence à traiter qui va me bloquer quelques jours ... Si quelqu'un peut lui faire sa fonction VBA pour traiter son point 2 ...
Désolé de lâcher l'affaire comme cela.
A+

 

[ReneDav14000]

Bonsoir,
Il m'est tombé une urgence à traiter qui va me bloquer quelques jours ... Si quelqu'un peut lui faire sa fonction VBA pour traiter son point 2 ...
Désolé de lâcher l'affaire comme cela.
A+

Bonjour Deadpool
Je pense avoir trouvé une solution. En cas de problème je reviendrai chercher de l'aide.
Merci encore pour ton travail.