XL 2016 Formule de compilation

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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

Cliquez pour agrandir...

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 ...

Cliquez pour agrandir...