XL 2010 Recherche et renvoi

chokili20

XLDnaute Junior
Bonjour le forum,

J'ai un tableau excel avec plusieurs onglets avec pour chaque ligne l'activité et le matériel acheté.
Sur la feuille 1 j'aimerais regrouper par activité les infos qui sont dans les autres feuillets.
Lorsque je tape gym par exemple, toutes les lignes gym doivent être notées.
Le nombre de feuille peut varier, le nombre d'activité et de ligne aussi.
Merci
 

Pièces jointes

  • Achat matériel sport.xlsx
    16.5 KB · Affichages: 10

job75

XLDnaute Barbatruc
Bonsoir chokili20, djidji59430,

Voyez le fichier joint et les 2 macros dans le code de Feuil1.

La macro Worksheet_Activate permet de créer la liste de validation en J1.

La macro Worksheet_Change filtre les feuilles selon le critère choisi.

A+
 

Pièces jointes

  • Achat matériel sport(1).xlsm
    30.9 KB · Affichages: 14

job75

XLDnaute Barbatruc
C'est très simple, pour faire passer le nombre de colonnes de 7 à 10 :

- en Feuil1 insérez 3 colonnes à droite de la colonne H => J1 devient M1 et la colonne L devient la colonne O

- dans les macros remplacez [J1] par [M1] et [L2] par [O2]

- dans la 2ème macro remplacez ncol = 7 par ncol = 10.

Bien sûr dans toutes les feuilles les tableaux doivent avoir 10 colonnes.
 
Dernière édition:

job75

XLDnaute Barbatruc
Bon allez pour avoir une adaptation automatique dans ce fichier (3) j'ai nommé les cellules Filtre et Liste et un peu modifié les macros :
VB:
Private Sub Worksheet_Activate()
Dim d As Object, w As Worksheet, tablo, i&, x$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
d("<Tous>") = ""
For Each w In Worksheets
    If w.Name <> Me.Name Then
        tablo = w.UsedRange.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
        For i = 2 To UBound(tablo)
            x = CStr(tablo(i, 1))
            If x <> "" Then d(x) = ""
        Next i
    End If
Next w
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
[Filtre].Validation.Delete 'nom défini
With [Liste] 'nom défini
    .Resize(d.Count) = Application.Transpose(d.keys) 'Transpose est limitée à 65536 lignes
    If d.Count > 1 Then .Offset(1).Resize(d.Count).Sort .Cells, xlAscending, Header:=xlNo 'tri
    [Filtre].Validation.Add xlValidateList, Formula1:="=" & .Resize(d.Count).Address 'liste de validation
    .Offset(d.Count).Resize(Rows.Count - d.Count - .Row + 1).ClearContents 'RAZ dessous
    Worksheet_Change [Filtre] 'lance la macro
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Filtre]) Is Nothing Then Exit Sub
Dim crit$, ncol%, w As Worksheet, tablo, i&, x$, n&, a(), j%
crit = LCase(CStr([Filtre]))
ncol = [A1].CurrentRegion.Columns.Count 'cellule à adapter éventuellement
If ncol = 1 Then ncol = 2 'pour avoir au moins 2 éléments
For Each w In Worksheets
    If w.Name <> Me.Name Then
        tablo = w.UsedRange.Resize(, ncol) 'matrice, plus rapide
        For i = 2 To UBound(tablo)
            x = CStr(tablo(i, 1))
            If x <> "" And (LCase(CStr(tablo(i, 1))) = crit Or crit = "<tous>") Then
                n = n + 1
                ReDim Preserve a(1 To ncol, 1 To n)
                For j = 1 To ncol
                    a(j, n) = tablo(i, j)
                Next j
            End If
        Next i
    End If
Next w
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] 'cellule à adapter éventuellement
    If n Then
        .Resize(n, ncol) = Application.Transpose(a) 'Transpose est limitée à 65536 lignes
        .Resize(n, ncol).Borders.Weight = xlThin
        .Resize(n, ncol).Sort .Cells(1), xlAscending, Header:=xlNo 'tri pour le cas <Tous>
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).Delete xlUp 'RAZ dessous
End With
End Sub
Edit : le fichier n'était pas destiné à ce fil, je joins le bon.
 

Pièces jointes

  • Achat matériel sport(3).xlsm
    33.2 KB · Affichages: 12
Dernière édition:

patate38

XLDnaute Junior
Bonsoir,
Je souhaite utiliser la proposition de job75 (post 5) mais
l'ordinateur de l'association est sous mac. Lorsque j'ouvre le document il est écrit :
Erreur d'exécution 429, un composant active X ne peut pas créer d'objet,
débogage.
Est ce que quelqu'un peut m'aider ?
merci
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T