XL 2016 Synthese - renvoi d'info sur un onglet

[tuti]

bonjour,
sur un fichier, j'ai créer mes items 01 à 15 + intitulé rapide et commentaire

je souhaiterais dupliquer l'onglet 01 - 02 jusqu'à 99

je pourrais appeler les ( 17 item * 99 onglet = 1683 item ) à la main ( 1 par 1 )
mais 1600 item, cela est quasi masochiste




je pensais nommer mes onglet/dossier dans la colonne A puis faire des RECHERCHEV à partir de l'info contenu dans la cellule
A3 pour le dossier 01
A4 pour le dossier 02
A5 pour le dossier 03
...

dans mon onglet SYNTHESE, comment renvoyer l'info facilement/rapidement ?

merci

 

[piga25]

Bonjour,

En vba cela est possible :

Sub ExtraireNomsEtValeurs()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim targetSheet As Worksheet

    ' Feuille où vous souhaitez afficher les résultats
    Set targetSheet = ThisWorkbook.Sheets("Synthese") ' Remplacez par le nom de votre feuille

    ' Démarrer à la ligne 2 (ajuster si nécessaire)
    lastRow = 2

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> targetSheet.Name Then ' Ignorer la feuille des résultats
            targetSheet.Cells(lastRow, 1).Value = "Feuille " & ws.Name & " - " & ws.Range("H1").Value
            targetSheet.Cells(lastRow, 3).Value = ws.Range("B2").Value ' Item 1 à 15
            targetSheet.Cells(lastRow, 4).Value = ws.Range("B3").Value
            targetSheet.Cells(lastRow, 5).Value = ws.Range("B4").Value
            targetSheet.Cells(lastRow, 6).Value = ws.Range("B5").Value
            targetSheet.Cells(lastRow, 7).Value = ws.Range("D2").Value
            targetSheet.Cells(lastRow, 8).Value = ws.Range("D3").Value
            targetSheet.Cells(lastRow, 9).Value = ws.Range("D4").Value
            targetSheet.Cells(lastRow, 10).Value = ws.Range("D5").Value
            targetSheet.Cells(lastRow, 11).Value = ws.Range("J3").Value
            targetSheet.Cells(lastRow, 12).Value = ws.Range("L3").Value
            targetSheet.Cells(lastRow, 13).Value = ws.Range("L5").Value
            targetSheet.Cells(lastRow, 14).Value = ws.Range("O2").Value
            targetSheet.Cells(lastRow, 15).Value = ws.Range("O3").Value
            targetSheet.Cells(lastRow, 16).Value = ws.Range("O4").Value
            targetSheet.Cells(lastRow, 17).Value = ws.Range("O5").Value
            targetSheet.Cells(lastRow, 18).Value = ws.Range("E3").Value ' Intitulé rapide
            targetSheet.Cells(lastRow, 19).Value = ws.Range("E5").Value 'Commentaire
          
            lastRow = lastRow + 1
        End If
    Next ws
End Sub

 

[tuti]

cela fait ce que je souhaite faire
mais je ne maitrise pas les ( macros - vba - formules matricielles )

au pire, je pourrais le faire le temps de la création du fichier
mais les modif de cellule ne serait pas pris en compte si je ne clique pas sur le bouton

 

[laurent950]

Bonjour

Vous pouvez ajouter "Dans la boucle For" des liens hypertextes dans la synthèse pour accéder directement à chaque onglet spécifique, et réciproquement, des liens dans chaque onglet pour revenir à la synthèse.

La première ligne crée un lien dans la synthèse pour accéder à l'onglet correspondant :

.Hyperlinks.Add Anchor:=.Cells(lastRow, 1), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=.Cells(lastRow, 1).Value

La seconde ajoute un lien dans l'onglet pour revenir à la synthèse :

ws.Hyperlinks.Add Anchor:=ws.Range("A1:G1"), Address:="", SubAddress:="Synthese!A" & lastRow, TextToDisplay:="Dossier N°"

Sub ExtraireNomsEtValeurs()
    Dim targetSheet As Worksheet
        Set targetSheet = ThisWorkbook.Sheets("Synthese")
    Dim lastRow As Long
        lastRow = 3 ' A adapter en fonction de la première ligne de départ.
    Dim ws As Worksheet

    With targetSheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Data" And _
           ws.Name <> targetSheet.Name Then ' Ignorer la feuille des résultats
            .Cells(lastRow, 1).Value = ws.Name & " ---> [Dos N° " & ws.Range("H1").Value & "]"
            .Cells(lastRow, 2).Value = ws.Range("B2").Value ' Item 1
            .Cells(lastRow, 3).Value = ws.Range("B3").Value ' Item 2
            .Cells(lastRow, 4).Value = ws.Range("B4").Value ' Item 3
            .Cells(lastRow, 5).Value = ws.Range("B5").Value ' Item 4
            .Cells(lastRow, 6).Value = ws.Range("D2").Value ' Item 5
            .Cells(lastRow, 7).Value = ws.Range("D3").Value ' Item 6
            .Cells(lastRow, 8).Value = ws.Range("D4").Value ' Item 7
            .Cells(lastRow, 9).Value = ws.Range("D5").Value ' Item 8
            .Cells(lastRow, 10).Value = ws.Range("J3").Value ' Item 9
            .Cells(lastRow, 11).Value = ws.Range("L3").Value ' Item 10
            .Cells(lastRow, 12).Value = ws.Range("L5").Value ' Item 11
            .Cells(lastRow, 13).Value = ws.Range("O2").Value ' Item 12
            .Cells(lastRow, 14).Value = ws.Range("O3").Value ' Item 13
            .Cells(lastRow, 15).Value = ws.Range("O4").Value ' Item 14
            .Cells(lastRow, 16).Value = ws.Range("O5").Value ' Item 15
            .Cells(lastRow, 17).Value = ws.Range("E3").Value ' Intitulé rapide
            .Cells(lastRow, 18).Value = ws.Range("E5").Value ' Commentaire
        ' Creation des liens
            .Hyperlinks.Add Anchor:=.Cells(lastRow, 1), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=.Cells(lastRow, 1).Value
            ws.Hyperlinks.Add Anchor:=ws.Range("A1:G1"), Address:="", SubAddress:="Synthese!A" & lastRow, TextToDisplay:="Dossier N°"
            lastRow = lastRow + 1
        End If
    Next ws
    End With
End Sub

 

[C'est papy Mougeot !]

Bonjour,
Un essai sans code mais c'est lourd

 

[laurent950]

Bonsoir @tuti

Essayer de dupliquer les 98 Onglets qui sont la copie de l'onglet 01
Pour effectuer des Tests

@fcyspm30 (Il faut utiliser du VBA = je pense !) car pour lier dynamiquement la feuille de synthèse aux 99 onglets. Par exemple, si l'Item 5 est modifié dans l'Onglet 55 (Dossier 55), la mise à jour sera automatique dans la synthèse, et inversement. Le VBA assurera une synchronisation en temps réel dans les deux sens.

Sub DupliquerOnglets()
    Dim i As Integer
    Dim nomFeuille As String
    Application.ScreenUpdating = False
    ' Boucle pour créer les 99 feuilles identiques a la Feuilles 01
    For i = 2 To 99
        ' Copie de la première feuille
            Worksheets("01").Copy After:=Sheets(Sheets.Count)
     
        ' Nommage de la nouvelle feuille avec un format à 2 chiffres (ex : "02", "03", etc.)
            nomFeuille = Format(i, "00")
            ActiveSheet.Name = nomFeuille
            Worksheets(nomFeuille).Cells(1, 8) = i
    Next i
    Application.ScreenUpdating = True
End Sub

 

[tuti]

bonsoir,
je vous remercie
je ne suis pas à l'aise avec le code , mais le raccourci avec l'url est vraiment nice ( surtout après une dizaine d'onglet )

pour renforcer le tableau de synthese, j'ai souhaiter créer un TCD en onglet 1
mais maintenant, j'ai une petite erreur

quel mention je dois modifier pour prendre en compte la création d'un tableau en amont ?
cela devrait être un onglet TCD avec un graph si possible

je fignole mes cellules verrouiller avant de faire des essais sur un maximum d'onglet

@ fcyspm30
n'est ce pas une formule matricielle ?
si cela est le cas, cela laisse le choix au personne selon leur préférence

 

[laurent950]

Bonsoir
Poster le fichier avec L'onglet 01 qui contient le TDC mais a mon avis c'est pas possible a voir

pour renforcer le tableau de synthese, j'ai souhaiter créer un TCD en onglet 1

 

[tuti]

maintenant que j'ai ajouter un onglet TCD, quand je clique sur la macro
le message erreur ( indiqué au dessus )

aussi, j'ai ce popup

que signifie t'il ?

aussi, je remarque qu'il compil les infos en provenance de la feuille nommer TCD
dans la macro, j'ai bien vu l'emplacement pour ignorer les feuilles
mais je ne sais pas comment le saisir

 

[laurent950]

Bonjour @tuti

aussi, je remarque qu'il compil les infos en provenance de la feuille nommer TCD
dans la macro, j'ai bien vu l'emplacement pour ignorer les feuilles
mais je ne sais pas comment le saisir

' Ajouter : ' Liste des feuilles à ignorer (cf. VBA ci-dessous)
Maintenant que j'ai ajouté un onglet "TCD", lorsque je clique sur la macro,
le message d'erreur (indiqué ci-dessus) ne devrait plus apparaître !

Sub ExtraireNomsEtValeurs()
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Sheets("Synthese")
  
    Dim lastRow As Long
    lastRow = 3 ' A adapter en fonction de la première ligne de départ.
  
    Dim ws As Worksheet
  
    ' Ajout :  j'ai bien vu l'emplacement pour ignorer les feuilles mais je ne sais pas comment le saisir
    Dim FeuillesIgnorées As Variant
    Dim FeuilleTrouvée As Boolean
    Dim i As Integer
  
    ' Liste des feuilles à ignorer
    FeuillesIgnorées = Array("Data", targetSheet.Name, "TCD")
    ' Tu peux ajouter d'autres noms ici exemple :
    '                         FeuillesIgnorées = Array("Data", targetSheet.Name, "TCD","Feuil5","Feuil9")
  
  
    With targetSheet
        For Each ws In ThisWorkbook.Worksheets
          
            FeuilleTrouvée = False
            ' Vérifie si la feuille est dans la liste des feuilles à ignorer
            For i = LBound(FeuillesIgnorées) To UBound(FeuillesIgnorées)
                If ws.Name = FeuillesIgnorées(i) Then
                    FeuilleTrouvée = True
                    Exit For
                End If
            Next i
          
            ' Si la feuille n'est pas à ignorer, traiter les données
            If Not FeuilleTrouvée Then
                .Cells(lastRow, 1).Value = ws.Name & " ---> [Dos N° " & ws.Range("H1").Value & "]"
                .Cells(lastRow, 2).Value = ws.Range("B2").Value ' ***
                .Cells(lastRow, 3).Value = ws.Range("B3").Value ' ***
                .Cells(lastRow, 4).Value = ws.Range("B4").Value ' ***
                .Cells(lastRow, 5).Value = ws.Range("B5").Value ' ***
                .Cells(lastRow, 6).Value = ws.Range("D2").Value ' ***
                .Cells(lastRow, 7).Value = ws.Range("D3").Value ' ***
                .Cells(lastRow, 8).Value = ws.Range("D4").Value ' ***
                .Cells(lastRow, 9).Value = ws.Range("D5").Value ' ***
                .Cells(lastRow, 10).Value = ws.Range("J3").Value ' ***
                .Cells(lastRow, 11).Value = ws.Range("L3").Value ' ***
                .Cells(lastRow, 12).Value = ws.Range("L5").Value ' ***
                .Cells(lastRow, 13).Value = ws.Range("J5").Value ' ***
                .Cells(lastRow, 14).Value = ws.Range("O2").Value ' ***
                .Cells(lastRow, 15).Value = ws.Range("O3").Value ' ***
                .Cells(lastRow, 16).Value = ws.Range("O4").Value ' ***
                .Cells(lastRow, 17).Value = ws.Range("O5").Value ' ***
                .Cells(lastRow, 18).Value = ws.Range("N6").Value ' ***
                .Cells(lastRow, 20).Value = ws.Range("E3").Value ' Intitulé rapide
                .Cells(lastRow, 21).Value = ws.Range("E5").Value ' Commentaire
                ' Création des liens
                .Hyperlinks.Add Anchor:=.Cells(lastRow, 1), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=.Cells(lastRow, 1).Value
                ws.Hyperlinks.Add Anchor:=ws.Range("A1:G1"), Address:="", SubAddress:="Synthese!A" & lastRow, TextToDisplay:="Dossier N°"
              
                lastRow = lastRow + 1
            End If
        Next ws
    End With
End Sub

 

[laurent950]

Re @tuti

Passer par Fichier > Informations > Inspecter le document pour voir plus en détail ce qui peut être supprimé.

aussi, j'ai ce popup

que signifie t'il ?

 

[tuti]

merci pour la fonction Inpecter

j'ai supprimer un commentaire, je ne sais pas ou
il indique de supprimer la feuille masquer que je ne souhaite pas faire

n'ayant jamais eu cela avant,
peux on lui dire de ne pas se réveiller ? ( le popup )

 

[laurent950]

C'est natif a excel, je dirais Non.

peux on lui dire de ne pas se réveiller ? ( le popup )

 

[tuti]

concernant la macro, j'ai remarquer que celle ci bugue quand la feuille est partiellement protégée
aussi, j'ai vu d'autre sujet qui indiqué la même chose

serait il possible que la macro retire la protection au début de son action ?
et la réactive à la fin
( je protege les cellules mais sans mettre de mot de passe )

 

[laurent950]

Bonjour @tuti,

Je vous invite à créer une nouvelle demande pour traiter ce nouveau sujet, qui diffère de la discussion actuelle. Pour aller de l'avant, pourriez-vous d'abord valider la solution apportée dans cette discussion ?

Cordialement,