XL 2016 Formule de compilation

My<3 · 11 Avril 2022

Bonjour,

je travail un fichier Excel dans lequel j'ai la possibilité de créer 150 nouveaux onglets qui se nomme automatiquement de 001 @ 150

Je veux qu'une fois un onglet créer et compléter en retournant dans ma feuille de compilation les informations de cette nouvelle feuille se copie dans ma compilation j'ai trouvé comme formule ceci mais comment je peux la rendre efficace sans devoir inscrire 150 fois la formule mais que chaque onglet aille sa propre ligne (s'il y a une révision de fait dans le feuille je veux écraser les ancienne données)

Sub Transpose()

Dim source001 As Excel.Range
Dim target001 As Excel.Range

Set source001 = Sheets("001").Range("Z1:Z6")
Set target001 = Sheets("Compilation").Range("B11:G11")
source001.Copy
target001.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

End Sub

Donc ma question est ... est-ce possible de rendre cette formule vivante pour me 150 onglets a venir mais que la formule arrêter si la feuille n'existe pas ou bien je dois ecrire cette formule 150 pour les 150 onglet/ligne

Merci a l'avance de votre coup de main

fanch55 · 12 Avril 2022

Bonjour,
N'ayant aucune idée de comment est fait ou structuré l'onglet Compilation,
le classeur ci-joint est un exemple à partir de tableau structuré.
2 types de formules sont proposées,
il suffit de faire insérer/ligne pour que les formules soient propagées aux nouvelles cellules.
A voir si cela répond à votre besoin

My<3 · 12 Avril 2022

fanch55 à dit:
Bonjour,
N'ayant aucune idée de comment est fait ou structuré l'onglet Compilation,
le classeur ci-joint est un exemple à partir de tableau structuré.
2 types de formules sont proposées,
il suffit de faire insérer/ligne pour que les formules soient propagées aux nouvelles cellules.
A voir si cela répond à votre besoin

Bonjour a vous très chère ange Excel! Merci pour votre retour qui est grandement apprécier!

Je me suis mal exprimé dans ma demande le tableau est déjà existant comme celui en pièce jointe. Inscrire une formule comme celle-ci ne rendra-t-elle pas mon ficher vraiment lourd? Je pensais plutôt utilisé une formule en code VBA qui copie les informations plutôt que d'utiliser une formule.

fanch55 · 12 Avril 2022

Au vu de l'image, la table n'est pas structurée et les 150 lignes sont déjà pré-implémentées.

A votre choix :

La sub Bld_Formules remplit les colonnes de la table avec les formules ad-hoc ,
opération à ne faire qu'une fois. Le classeur ne pèsera pas plus lourd ... et sera toujours synchrone .

La sub Set_Compil est à lancer à la demande pour synchroniser Compilation avec les autres feuilles, elle peut être associée à un bouton . A ne pas oublier de lancer à chaque modification de feuille .... ou à l'ouverture du classeur avant consultation ou impression .

VB:

Sub Bld_Formules()
Dim Start_Cell As Range, Ad As String
    Worksheets("Compilation").Activate
    Set Start_Cell = [A11]
    For J = Start_Cell.Row To Start_Cell.Row + 149
        Ad = Cells(J, Start_Cell.Column).Address
        For K = 1 To 6
            Cells(J, K + Start_Cell.Column).Formula = "=IFERROR(INDIRECT(" & Ad & "&""!Z""&" & K & "),"""")"
        Next
    Next
End Sub

Sub Set_Compil()
Dim Wf As Worksheet, Start_Cell As Range
    Worksheets("Compilation").Activate
    Set Start_Cell = [A11]
    On Error Resume Next
    For J = Start_Cell.Row To Start_Cell.Row + 149
        Set Wf = Worksheets(Cells(J, Start_Cell.Column).Value)
        If Not Wf Is Nothing Then _
            Cells(J, Start_Cell.Column + 1).Resize(, 6).Value = Application.Transpose(Wf.Cells(1, "Z").Resize(6))
        Set Wf = Nothing
    Next
End Sub

My<3 · 12 Avril 2022

fanch55 à dit:
Au vu de l'image, la table n'est pas structurée et les 150 lignes sont déjà pré-implémentées.

A votre choix :

La sub Bld_Formules remplit les colonnes de la table avec les formules ad-hoc ,
opération à ne faire qu'une fois. Le classeur ne pèsera pas plus lourd ... et sera toujours synchrone .

La sub Set_Compil est à lancer à la demande pour synchroniser Compilation avec les autres feuilles, elle peut être associée à un bouton . A ne pas oublier de lancer à chaque modification de feuille .... ou à l'ouverture du classeur avant consultation ou impression .

VB:

Sub Bld_Formules() Dim Start_Cell As Range, Ad As String Worksheets("Compilation").Activate Set Start_Cell = [A11] For J = Start_Cell.Row To Start_Cell.Row + 149 Ad = Cells(J, Start_Cell.Column).Address For K = 1 To 6 Cells(J, K + Start_Cell.Column).Formula = "=IFERROR(INDIRECT(" & Ad & "&""!Z""&" & K & "),"""")" Next Next End Sub Sub Set_Compil() Dim Wf As Worksheet, Start_Cell As Range Worksheets("Compilation").Activate Set Start_Cell = [A11] On Error Resume Next For J = Start_Cell.Row To Start_Cell.Row + 149 Set Wf = Worksheets(Cells(J, Start_Cell.Column).Value) If Not Wf Is Nothing Then _ Cells(J, Start_Cell.Column + 1).Resize(, 6).Value = Application.Transpose(Wf.Cells(1, "Z").Resize(6)) Set Wf = Nothing Next End Sub

J'ai tenter avec Set-Compil et ca ne renvois pas a la bonne ligne les données et lorsque j'ai activer la compilation a débuter en ligne 15 et je créer des nouvelles feuilles (je sais pas si ca l'as une importance mais la plus récente est toujours la première a coter de compilation) mais elle se compile en montant

fanch55 · 12 Avril 2022

Que la feuille existe ou non, cela ne change rien . Laissez la cellule de début à A11 .

Essayez la sub ci-dessous et postez moi ce qui a été tracé dans la fenêtre exécution de vba

VB:

Sub Set_Compil()
Dim Wf As Worksheet, Start_Cell As Range
    Worksheets("Compilation").Activate
    Set Start_Cell = [A11]
    Columns("B").NumberFormat = "@"
    On Error Resume Next
    For J = Start_Cell.Row To Start_Cell.Row + 149
        Set Wf = Worksheets(Cells(J, Start_Cell.Column).Value)
        If Not Wf Is Nothing Then
            Debug.Print "Ligne=" & J, "Feuille name=" & Wf.Name & " codename=" & Wf.CodeName, "valeur lue=" & Cells(J, Start_Cell.Column).Value
            Cells(J, Start_Cell.Column + 1).Resize(, 6).Value = Application.Transpose(Wf.Cells(1, "Z").Resize(6))
        Else
            Cells(J, Start_Cell.Column + 1).ClearContents
        End If
        Set Wf = Nothing
    Next
End Sub

My<3 · 12 Avril 2022

fanch55 à dit:

Que la feuille existe ou non, cela ne change rien . Laissez la cellule de début à A11 .

Essayez la sub ci-dessous et postez moi ce qui a été tracé dans la fenêtre exécution de vba

Regarde la pièce jointe 1136688

VB:

Sub Set_Compil()
Dim Wf As Worksheet, Start_Cell As Range
    Worksheets("Compilation").Activate
    Set Start_Cell = [A11]
    Columns("B").NumberFormat = "@"
    On Error Resume Next
    For J = Start_Cell.Row To Start_Cell.Row + 149
        Set Wf = Worksheets(Cells(J, Start_Cell.Column).Value)
        If Not Wf Is Nothing Then
            Debug.Print "Ligne=" & J, "Feuille name=" & Wf.Name & " codename=" & Wf.CodeName, "valeur lue=" & Cells(J, Start_Cell.Column).Value
            Cells(J, Start_Cell.Column + 1).Resize(, 6).Value = Application.Transpose(Wf.Cells(1, "Z").Resize(6))
        Else
            Cells(J, Start_Cell.Column + 1).ClearContents
        End If
        Set Wf = Nothing
    Next
End Sub

fanch55 · 13 Avril 2022

Étonnant :

d'après l'image initiale,

la cellule de départ devrait être A11

avec la trame ci-contre

Pourriez-vous refaire l'opération avec le code ci-dessous
et joindre les images de la fenêtre exécution et de la feuille compilation
sinon si vous pouviez me joindre un classeur exemple ...

VB:

Sub Set_Compil()
Dim Wc As Worksheet, Wd As Worksheet
Dim Cell_Deb As Range, Cell_Fin As Range, Cell_Ref As Range
    
    Set Wc = Worksheets("Compilation"): If Wc Is Nothing Then Exit Sub
        Wc.Activate
        Set Cell_Deb = Wc.[A11]
        Set Cell_Fin = Wc.Cells(Wc.Rows.Count, Cell_Deb.Column).End(xlUp)
        Cell_Deb.EntireColumn.NumberFormat = "@"
    
        On Error Resume Next
        For J = Cell_Deb.Row To Cell_Fin.Row
            Set Cell_Ref = Cells(J, Cell_Deb.Column)
            Set Wd = Worksheets(Cell_Ref.Value)
                Debug.Print Wd.CodeName & "=" & Wd.Name, Cell_Ref.Address & "=" & Cell_Ref.Value,
                If Not Wd Is Nothing Then
                    Wc.Cells(J, Cell_Deb.Column + 1).Resize(, 6).Value = Application.Transpose(Wd.Cells(1, "Z").Resize(6))
                    Debug.Print Wc.Cells(J, Cell_Deb.Column + 1).Resize(, 6).Address, "Writed"
                Else
                    Wc.Cells(J, Cell_Deb.Column + 1).ClearContents
                    Debug.Print , Cell_Ref.Address & "=" & Cell_Ref.Value, Wc.Cells(J, Cell_Deb.Column + 1).Resize(, 6).Address, "Cleared"
                End If
            Set Wd = Nothing
        Next
    Set Wc = Nothing
End Sub

My<3 · 13 Avril 2022

fanch55 à dit:

Étonnant :

d'après l'image initiale,

la cellule de départ devrait être A11

avec la trame ci-contre

Regarde la pièce jointe 1136718

Pourriez-vous refaire l'opération avec le code ci-dessous
et joindre les images de la fenêtre exécution et de la feuille compilation
sinon si vous pouviez me joindre un classeur exemple ...

VB:

Sub Set_Compil()
Dim Wc As Worksheet, Wd As Worksheet
Dim Cell_Deb As Range, Cell_Fin As Range, Cell_Ref As Range
  
    Set Wc = Worksheets("Compilation"): If Wc Is Nothing Then Exit Sub
        Wc.Activate
        Set Cell_Deb = Wc.[A11]
        Set Cell_Fin = Wc.Cells(Wc.Rows.Count, Cell_Deb.Column).End(xlUp)
        Cell_Deb.EntireColumn.NumberFormat = "@"
  
        On Error Resume Next
        For J = Cell_Deb.Row To Cell_Fin.Row
            Set Cell_Ref = Cells(J, Cell_Deb.Column)
            Set Wd = Worksheets(Cell_Ref.Value)
                Debug.Print Wd.CodeName & "=" & Wd.Name, Cell_Ref.Address & "=" & Cell_Ref.Value,
                If Not Wd Is Nothing Then
                    Wc.Cells(J, Cell_Deb.Column + 1).Resize(, 6).Value = Application.Transpose(Wd.Cells(1, "Z").Resize(6))
                    Debug.Print Wc.Cells(J, Cell_Deb.Column + 1).Resize(, 6).Address, "Writed"
                Else
                    Wc.Cells(J, Cell_Deb.Column + 1).ClearContents
                    Debug.Print , Cell_Ref.Address & "=" & Cell_Ref.Value, Wc.Cells(J, Cell_Deb.Column + 1).Resize(, 6).Address, "Cleared"
                End If
            Set Wd = Nothing
        Next
    Set Wc = Nothing
End Sub

Voila mon fichier je crois qu'il sera plus facile pour vous! Je suis reconnaissante de votre aide

fanch55 · 13 Avril 2022

Ok, vous travaillez avec une table structurée .
Le code ci-joint dans le classeur devrait fonctionner .
Nota: on copie les 6 premières valeurs de la colonne Z des feuilles 001 à 150 tel que vous l'avez demandé .
Je ne sais pas si c'est vraiment conforme à la feuille 000 ...

My<3 · 13 Avril 2022

fanch55 à dit:
Ok, vous travaillez avec une table structurée .
Le code ci-joint dans le classeur devrait fonctionner .
Nota: on copie les 6 premières valeurs de la colonne Z des feuilles 001 à 150 tel que vous l'avez demandé .
Je ne sais pas si c'est vraiment conforme à la feuille 000 ...

C'est merveilleux ! Tout semble fonctionner sur des roulettes! Je met a l'épreuve a compter d'aujourd'hui !!!! Je suis plus que reconnaissante de votre énorme coup de pouce tres cher!

Effectuez une recherche sur Excel Downloads...

XL 2016 Formule de compilation

My<3

XLDnaute Junior

fanch55

fanch55

XLDnaute Barbatruc

Pièces jointes

My<3

XLDnaute Junior

Pièces jointes

fanch55

XLDnaute Barbatruc

My<3

XLDnaute Junior

Pièces jointes

fanch55

XLDnaute Barbatruc

My<3

XLDnaute Junior

Pièces jointes

fanch55

XLDnaute Barbatruc

My<3

XLDnaute Junior

Pièces jointes

fanch55

XLDnaute Barbatruc

Pièces jointes

My<3

XLDnaute Junior

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums