De mon coté je cherchais à faire "moins long" : en effet le nom des feuilles se trouve dans la cellule après "Nombre d'Appareil" donc avec la fonction MID(Target.value,19) on récupère le nom de la feuille à activer et on fait un :
Sheets(MID(Target.value,19)).Activate
avce un test :
If Not Application.Intersect(Target, Range("B2:G2")) Is Nothing Then
où on test d'un coup l'ensemble des cellules titres cliquables.
ce qui donne en "Private" :
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Lancement de la procédure au double clic En Ordre Etalonnage.
If Not Application.Intersect(Target, Range("B2:G2")) Is Nothing Then
Cancel = True
Call Listing(Mid(Target.Value, 19))
End If
End Sub
et en module :
Option Explicit
Sub Listing(Optional Nom_Feuille As String)
Dim i&, ii&, k&
Dim shListe As Worksheet, shListing As Worksheet
'Tu peux modifier les délais souhaités ici:
Const jMax = 30
Const jMin = 0
'Enregistrement des feuilles.
With ThisWorkbook
Set shListe = .Sheets("Liste Générale")
Set shListing = .Sheets(Nom_Feuille)
End With
'Remise à zéro de la feuille Limite Etalonnage.
shListing.[a1].CurrentRegion.Offset(1).Clear
'Détermination de la dernière ligne de la feuille Liste Générale.
With shListe
k = 1
ii = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
'Boucle de la liste à la recherche des trois conditions.
For i = 2 To ii
'Vérifie les conditions demandées.
If .Cells(i, "I").Value > jMin And .Cells(i, "I").Value < jMax And .Cells(i, "L").Value = 0 Then
'Si les trois conditions sont remplies:
'Incrémentation de k
k = k + 1
'Copie de la ligne complète.
.Rows(i).Copy shListing.Cells(k, 1)
End If
Next i
End With
'Suppression du fond de la feuille Limite Etalonnage.
shListing.[a1].CurrentRegion.Offset(1).FormatConditions.Delete
'Ouvre la feuille Limite Etalonnage
shListing.Activate
End Sub
Reste à voir comment rendre "variable" le code d'extraction en fonction du titre cliqué.
Attention ! pour que cela fonctionne il faut que les titre du tableau soit de la forme suivante :
Nombre d'Appareil(retour à la ligne sans espace avec les touches [Alt]+[entrée])
Envoyé Etalonnage
L'ensemble sans espace inutile !
vbMBHB