Macro : Copier les 10 premiers résultats d'un filtre auto

Question

Petits soucis et maux de tête avec une macro excel à créer... Objectif : J'ai une liste d'applications gérées par 5 domaines Métier; des budget sont associés à ces applications, j'ai besoin d'extraire la liste des 10 applications dont les budgets sont les + élévés pour chaque domaine... Je dois donc copier les 10 premiers résultats d'une liste résultant d'un filtre automatique et d'un tri sur une autre feuille pré-formatée... Problème rencontrés: (N.B. : Manuellement : aucun problème pour copier-coller les données...) - 1) Je n'arrive pas à copier les résultats d'un filtre automatique avec une macro pour les coller dans une autre feuille - 2) Je n'arrive pas à copier les 10 premiers résultats (d'une liste beaucoup plus longue) de l'application successive de filtres et tris (les n° de ligne changent à chaque application d'un filtre) Quelqu'un aurait-il une idée ?!!... Merci, Jean...

Nad-Dan · Answer

Peux-tu mettre ton fichier avec des données bidons. Ce sera plus facile. Veille à ce que la structure soit la même d'un point de vue colonne et ce, dans les deux feuilles concernées. A te lire Dan...

Invité · Answer

Sans exemple, dur de t'aider plus mais un filtre élaboré devrait faire le travail. Mytå_Qc...

Nad-Dan · Answer

Voici une macro qui devrait te faire cela. Pour l'installer : ALT + F11 pour aller VBA Menu/insertion/module A droite, place la macro ci-dessous et enregistre ton fichier. Sub Transfert() 'Macro par DAN pour Baan sur excel Pratique - 14/08/07 Dim i As Integer, lig As Integer, ligne As Integer lig = Sheets("10applis").Range("E65536").End(xlUp).Row For i = 2 To lig If Sheets("10applis").Rows(i).Hidden = False Then With Sheets("Juillet_T0") ligne = .Range("a65536").End(xlUp).Row + 1 .Cells(ligne, 1) = Sheets("10applis").Cells(i, 2).Value .Cells(ligne, 2) = Sheets("10applis").Cells(i, 3).Value .Cells(ligne, 5) = Sheets("10applis").Cells(i, 4).Value .Cells(ligne, 6) = Sheets("10applis").Cells(i, 5).Value .Cells(ligne, 9) = Sheets("10applis").Cells(i, 6).Value .Cells(ligne, 10) = Sheets("10applis").Cells(i, 7).Value .Cells(ligne, 12) = Sheets("10applis").Cells(i, 8).Value End With End If Next i End Sub Mets ton filtre automatique et fait un tri sur la colonne de ton choix. exécute la macro en question en la sélectionnant par menu/données/macro/macro Tu peux lui attribuer un raccourci clavier par menu/données/macro/macro et là sélectionner la macro puis cliquer sur "Options" et choisir une lettre (par ex --&gt; t). En apputant sur CRT + t la macro sera alors exécutée. A te lire Dan...

Invité · Answer

Une façon de travailler avec le filtre automatique et la fonction Find. Tout le transfère des données est automatisées, juste un bouton à cliquer. Le fichier CopyFilter.xls Mytå P.S. Dan ta macro n'est pas correct c'est le contraire de la feuille Juillet_T0 vers la feuille 10applis...

Nad-Dan · Answer

Re,

Oups Myta, je viens de voir ton fichier.

Pfff , j'ai fait le contraire !!!

Bon la macro est juste mais cela ne résoud pas ton pb Baan ! Donc là oublie moi et fonce sur ce que Myta te donne. Cela correspond à ce que tu demandes.

Je laisse cette macro pour celui qui veut l"utiliser en considérant la récupération des valeurs filtrées de la feuille appli10 vers la feuille Juillet.

Encore désolé et merci à toi Myta

Dan

Invité · Answer

Re le forum

Petite correction du code de ma macro

'...
If C.Row = 1 Then Exit Do
Nbre = Nbre + 1
'...

Afin d'éviter un Filtre automatique sans valeurs d'affichées.

Code complet

Sub CopyFilter()
Dim C As Range
Dim Ligne As String
Dim I As Byte
Dim Nbre As Byte
Dim Critere As String

'Vérifier la présence du Filtre automatique
With Sheets("Juillet_T0")
    .Activate
    If Not .AutoFilterMode Then .Rows(1).AutoFilter
    On Error Resume Next
    .ShowAllData
'Trier la colonne Bubget (Ordre décroissant)
    .Range("A1").CurrentRegion.Sort Key1:=Range("I1"), Order1:=xlDescending
'Exécution du Filtre automatique
    For I = 1 To 66 Step 11
        With Sheets("10applis")
            .Range("B" & I + 1 & ":H" & I + 10).ClearContents
            Critere = .Cells(I, 1).Value
        End With
    If Critere = "Tous" Then
        Selection.AutoFilter Field:=5
    Else
        Selection.AutoFilter Field:=5, Criteria1:=Critere
    End If
'Transfère des données filtrées (Maximum 10)
Nbre = 0
    With .AutoFilter.Range.Columns(1)
        Ligne = .Cells(1).Address
            Set C = .Columns(1).Find("*")
                Do
                    If C.Row = 1 Then Exit Do
                    Nbre = Nbre + 1
                    'MsgBox C.Row
                    'Copier les données
                        Sheets("10applis").Range("B" & I + Nbre) = .Range("A" & C.Row)
                        Sheets("10applis").Range("C" & I + Nbre) = .Range("B" & C.Row)
                        Sheets("10applis").Range("D" & I + Nbre) = .Range("E" & C.Row)
                        Sheets("10applis").Range("E" & I + Nbre) = .Range("F" & C.Row)
                        Sheets("10applis").Range("F" & I + Nbre) = .Range("I" & C.Row)
                        Sheets("10applis").Range("G" & I + Nbre) = .Range("J" & C.Row)
                        Sheets("10applis").Range("H" & I + Nbre) = .Range("L" & C.Row)
                    Set C = .FindNext(C)
                Loop Until C.Address = Ligne Or Nbre = 10
    End With
    Next I
End With
Sheets("10applis").Activate
End Sub

Mytå

Invité · Answer

Baan, la partie qui détermine le filtrage '... 'Exécution du Filtre automatique For I = 1 To 66 Step 11 With Sheets("10applis") .Range("B" &amp; I + 1 &amp; ":H" &amp; I + 10).ClearContents Critere = .Cells(I, 1).Value End With If Critere = "Tous" Then Selection.AutoFilter Field:=5 Else Selection.AutoFilter Field:=5, Criteria1:=Critere End If '... Critere = .Cells(I, 1).Value lit la valeur du critère du filtre ici Ligne I colonne A. Soit les valeurs de $A$1, $A$12, $A$23, .... $A$56 Mytå...

Invité · Answer

Il y a une ligne dans la macro pour trier ta colonne Budget (Décroissant) 'Trier la colonne Budget (Ordre décroissant) .Range("A1").CurrentRegion.Sort Key1:=Range("I1"), Order1:=xlDescending Surement juste une adaptation de la plage de trie Mytå...