XL 2021 Remplir des listes à partir d'une base de données

[chajmi]

Bonjour,
J'ai une base de données en feuille "A"
Comment renseigner automatiquement mes tableaux en feuille "B"

Merci de votre aide

 

[chajmi]

Bonsoir chajmi, le forum,

En effet ALS35 a raison, il suffit de quelques corrections, le code dans Thisworkbook :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim P As Range, numlig As Range, i As Variant, numcol As Range
If Not IsNumeric(Sh.Name) Then Exit Sub
Application.ScreenUpdating = False
Sh.[C6].Resize(Sh.Rows.Count - 5, Sh.Columns.Count - 2).ClearContents 'RAZ
On Error Resume Next 'si aucune SpecialCell
Set P = Sh.Columns(2).SpecialCells(xlCellTypeConstants, 1)
With Sheets("BASE")
    For Each numlig In P
        i = Application.Match(numlig, .Range("A5:A" & .Rows.Count), 0)
        For Each numcol In Sh.Rows(2).SpecialCells(xlCellTypeConstants, 1)
            If IsNumeric(i) Then Sh.Cells(numlig.Row, numcol.Column) = .Cells(i + 4, numcol)
    Next numcol, numlig
End With
P.EntireRow.Sort Sh.Columns(3), xlAscending, Sh.Columns(2), , xlAscending, Header:=xlNo 'tri sur 2 colonnes
ActiveWindow.ScrollRow = 6 'cadrage
End Sub

Activez les feuilles 1 2 3 4.

A+

Quand j'ouvre le fichier que vous avez modifié, j'ai 2 messages d'erreur. Et rien ne fonctionne

 

[job75]

Bonjour chajmi,

Je ne peux rien vous dire car les fichiers que j'ai joints fonctionnent sans problème chez moi sur Win 11 Excel 2019.

A+

 

[chajmi]

NON RÉSOLU

 

[fanfan38]

Bonjour
Ci joint ma solution

A+ François

 

[job75]

Bonjour le forum,

Ah oui merci François, j'avais complètement zappé les "x" en colonnes C D E F G de la feuille "BASE".

Maintenant ce fichier (3) en tient compte avec la macro dans ThisWorkbook :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim P As Range, Q As Range, lig&, r As Range, i&, refcol As Range, j As Variant
If Not IsNumeric(Sh.Name) Then Exit Sub
Application.ScreenUpdating = False
Sh.Protect "123", UserInterfaceOnly:=True 'la protection permet les modifications par macro
Sh.Rows.Hidden = False 'affiche tout
Sh.Rows("5:" & Sh.Rows.Count).ClearContents 'RAZ
On Error Resume Next 'si aucune SpecialCell
With Sheets("BASE")
    .Protect "123", UserInterfaceOnly:=True 'déprotection nécessaire avec les SpecialCells
    Select Case Val(Sh.Name)
        Case 1: Set P = .Columns("D:E") 'CA + Bureau
        Case 2: Set P = .Columns("C")
        Case 3: Set P = .Columns("G")
        Case 4: Set P = .Columns("F")
    End Select
    Set Q = Sh.Rows(4).SpecialCells(xlCellTypeConstants, 2)
    lig = 4
    For Each r In Intersect(P, P.SpecialCells(xlCellTypeConstants, 2).EntireRow).Rows 'ligne de 1 ou 2 cellules
        If Application.CountIf(r, "x") Then 'NB.SI
            lig = lig + 1
            i = r.Row
            Sh.Cells(lig, 2) = .Cells(i, 1)
            For Each refcol In Q
                j = Application.Match(refcol, .Rows(2), 0)
                If IsNumeric(j) Then Sh.Cells(lig, refcol.Column) = .Cells(i, j)
            Next refcol
        End If
    Next r
End With
Sh.Rows("4:" & lig).Sort Sh.Columns(3), xlAscending, Header:=xlYes 'tri sur les noms
i = Sh.Cells.SpecialCells(xlCellTypeLastCell).Row 'dernière ligne du UsedRange
If i > lig Then Sh.Rows(lig + 1 & ":" & i).Hidden = True 'masque les lignes vides
ActiveWindow.ScrollRow = 5 'cadrage
End Sub

Nota 1 : avec cette solution les doublons en colonne A de la feuille "BASE" sont possibles sans poser de problème..

Nota 2 : les formules avec la fonction LIEN_HYPERTEXTE étaient tarabiscotées, je les ai simplifiées.

A+

 

[job75]

Cela dit @chajmi vous n'avez peut-être pas résolu le problème signalé au post #16.

Dans ce cas votre fichier est peut-être corrompu, il vous faut le reconstruire.

Edit : notez que j'ai revu tous les liens hypertextes, est-ce que le problème persiste ?