Copier des lignes en fonction d'une variable dans des onglet

Bonsoir,

Je pense qu'on pourrait améliorer le temps de traitement, juste en décalant certaines lignes de code :

En début de code, tu modifies ainsi :

....
....
    Set Plg = .Range("A1:J" & Derlig) 'ATTENION à bien définir la plage(dans ton fichier réel, remplace J par CK)
    For Each Cel In .Range("I2:I" & Derlig) 'Ici, remplace I par CC
        If Not IsEmpty(Cel) Then
            Prob(Cel.Value) = Cel.Value
        End If
    Next Cel
....
....

Et un peu plus bas, tu modifies ainsi :

....
....
    For Each Itm In Prob.Items
        If IsError(Application.Match(Itm, Ordi, 0)) And IsError(Application.Match(Itm, Anim, 0)) Then
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Itm
            .Range("CK2").FormulaR1C1 = "=RC9=""" & Itm & """" 'ici tu remplaces RC9 par RC81 (81 ème colonne, soit CC)
            Plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
                "CK1:CK2"), CopyToRange:=ActiveSheet.Range("A1"), Unique:=False
        End If
    Next Itm
....
....

Maintenant, je ne comprends pas du tout ce que tu veux, pour le "ZOOM"?????

Pourquoi copier 2 fois le même onglet?

Dans l'onglet "sommaire", tu peux créer une liste de tous les onglets, avec des liens hypertexte vers chacun des onglets...

Regarde un peu dans le forum, tu devrais trouver tout ce qu'il faut.

Et reviens si c'est pas le cas, ou si je n'ai pas compris du tout....

Bonne soirée

cela sera peut être plus claire avec l'exemple ci-joint.

pour le sommaire, j'ai trouver ca sur le forum :

Private Sub Worksheet_Activate()

For I = 1 To ActiveWorkbook.Sheets.Count

Cells(I, 1) = ActiveWorkbook.Sheets(I).Name

Next

End Sub

Après modifications, je te confirme que toutes choses égales par ailleurs cela fait gagner environ 2snd sur le temps d’exécution de la macro (sur mon ordi). On passe ainsi de 15.2snd à 13snd. (avec le chrono du téléphone et mon temps de réaction!) ^^

Re-,

En toute fin de code, mets ce code :

....
....
    .Range("CK2").Clear
End With
Sheets.Add Before:=Sheets(1)
I = 1
With ActiveSheet
    .Name = "Sommaire"
    For Each Sh In Sheets
        If Sh.Name <> "Base" And Sh.Name <> "Sommaire" Then
            .Hyperlinks.Add Anchor:=.Cells(I, 1), Address:="", SubAddress:= _
                Sh.Name & "!A1", TextToDisplay:=Sh.Name
            I = I + 1
        End If
    Next Sh
End With
End Sub

Bonne soirée

Re-,

Pour calculer le temps exact, tu mets en tout début de code :

t = timer

et en toute fin de code, avant le End Sub :

MsgBox Timer - t

je te confirme que le timer est plus précis que mon doigt sur le téléphone ! ^^ 12.06 (moi qui pensais avoir de bon réflexes!)

pour le sommaire, ça fonctionne mais par pour tout les onglets sur certain cela met "référence non valide" (alors qu'il y a pas de raison!)

je te remercie en tout cas.

je vais continuer à chercher pour les onglets avec TCD.