XL 2019 Création automatique des onglets en fonction de critères

sylvanu à dit:

Voilà, avec :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [C2:C1000]) Is Nothing Then
        If Target = "" Then Exit Sub
        NomOnglet = Target.Value
        Sheets(NomOnglet).Select
        Sheets(NomOnglet).Range("A1").Select
    End If
Fin:
End Sub

Et comme la question suivante va être "Comment faire quand on est sur un onglet pour revenir sur l'onglet principal, car j'ai beaucoup d'onglets ?"
Il suffit de d'appuyer sur la touche "²" ( qui généralement ne sert quasiment à rien ) avec :

Code:

Sub Workbook_Open()
     Application.OnKey "²", "ActiveOnglet"
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     Application.OnKey "²"
End Sub
et
Sub ActiveOnglet()
    Sheets("Onglets").Select
End Sub

Cliquez pour agrandir...

sylvanu à dit:

Bonjour Rmjunivers,
En PJ un essai où j'ai rajouté la suppression des lignes inutiles :

VB:

Sub SupprimerDESC_READING_CENTER(Nom)
' Supprime toutes les lignes non concernées par le DESC_READING_CENTER
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    With .Columns(26)
        .FormulaR1C1 = "=IF(RC[-23]=" & Nom & ",0,1)"   ' Repère les lignes concernées
        .Value = .Value                                 'supprime les formules
        .EntireRow.Sort .Cells, xlDescending            'tri pour regrouper et accélérer
        On Error Resume Next                            'si aucune SpecialCell
        .SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
        .EntireColumn.Delete                            'supprime la colonne auxiliaire
    End With
End With
With ActiveSheet.UsedRange: End With                    'actualise les barres de défilement
End Sub

Cliquez pour agrandir...

sylvanu à dit:

Bonsoir,
Oups, j'ai ... un peu trop optimisé.
Je pense qu'en PJ c'est rectifié.

Cliquez pour agrandir...