Sélectionner une cellule cible dans autre feuille

[chris6999]

Bonjour

Je reprends un projets que j'avais un peu laissé de coté en l'abordant sous un autre angle.
Impossible de retrouver mon premier fil sur ce sujet.

Je pars de ma feuille Recap.
A partir d'un double clic dans la plage J5 à J19
La macro sélectionne une cellule dans la feuille CALENDRIER dont l'adresse est déterminée comme suit:
Numéro de ligne : le même numéro de ligne que celle où se déclenche le double clic
Numéro de colonne : le numéro de colonne où se situe dans la feuille CALENDRIER la date correspondant à celle présente dans la cellule où est réalisé le double clic.

Exemple si je double clique su J5
Sélectionne dans la feuille Calendrier la cellule située sur :
la cinquième ligne
la 14ème colonne (puisque la date 10/02 est situé dans la colonne N (14) de la feuille CALENDRIER.

Merci d'avance pour votre aide
Bonne soirée

 

[Hieu]

Salut,

Une idée :

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, Sheets("Récap").Range("j5:j16")) Then
    lig = Target.Row
    col = WorksheetFunction.Match(Target, Sheets("CALENDRIER").Rows(4), 0)
End If
Sheets("CALENDRIER").Activate
Cells(lig, col).Select
End Sub

Je n'ai pas réussi à concaténer les deux dernieres lignes du code, si quelqu'un a une idée ?!

 

[chris6999]

Bonjour

Merci c'est exactement comme ça que j'imaginais ce code.
Je vais tester tout ça

Bonne journée

 

[chris6999]

Re

J'ai testé ta proposition mais cela ne fonctionne pas.
La feuille CALENDRIER s'ouvre mais le système ne pointe pas sur la cellule attendue.
J'ai un bug "Erreur d'exécution 1004" sur le code Cells(lig, col).Select

Dommage j'avais bon espoir

Bon après midi

 

[Si...]

salut

autre proposition :

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
    If Intersect(R, [J5:J16]) Is Nothing Then Exit Sub
    Dim L As Long, C As Byte
    With Feuil2
        L = .[C:C].Find(R(1, -6)).Row
        C = Application.Match(R, .Rows(4), 0)
        .Cells(L, C) = "Ici"    'ou là ou ... pour voir
        Application.Goto .Cells(L, C)
    End With
End Sub

 

[chris6999]

Bonsoir et merci Barbatruc
Ton code fonctionne super bien.
Par contre comment éviter le bug lorsque c ne trouve pas de correspondance?
c = Application.Match(R, .Rows(4), 0)
Bonne soirée

 

[Si...]

re

et 1si... ?

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
    If Intersect(R, [J5:J16]) Is Nothing Then Exit Sub
    Dim L As Long, C As Long
    With Feuil2
        L = .[C:C].Find(R(1, -6)).Row
        If IsError(Application.Match(R, .Rows(4), 0)) Then
          MsgBox "Il ya un manque !", , "Oups"
        Else
          C = Application.Match(R, .Rows(4), 0)
          .Cells(L, C) = "Ici"    'ou là ou ... pour voir
          Application.Goto .Cells(L, C)
        End If
    End With
End Sub

 

[chris6999]

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)

Nickel merci encore