Filtre automatique des données sur VBA

Bonjour,

j'ai une liste de donnée excel a faire filtre par period comme vous le verrez dans l'exemple en pièce jointe.

Bien mon but est de faire un filtre automatique en fonction des périodes Q1, Q2 … de façon a utiliser ses données par période uniquement ( en faisant des recherchesV ou autres formules par la suite.)

si possible que pour chaque période filtrée j'ai une nouvelle feuille appropriée.

NB

je suis débutant des débutants sur VBA alors voila ce que j'ai essayer en regardant a gauche a droite mais sans succès car j'ai une erreur a la fin "error 429"

Vous me rendriez un grand service en m'aidant.

Merci d'avance

Bonsoir

A vérifier si ce que tu veux

zlam a écrit :

car j'ai une erreur a la fin "error 429"

sans le fichier avec la macro difficile de trouver

Merci pour ta réponse mais quand je je lance la macro j'ai toujours l'error 429Option Explicit

Sub Filtre()

Dim J As Long, Nblg As Long

Dim Mondico As Object, DicoKey

Dim Ws As Worksheet

Application.ScreenUpdating = False

Set Ws = ActiveSheet

If Ws.FilterMode = True Then Ws.ShowAllData

Nblg = Range("F" & Rows.Count).End(xlUp).Row

Set Mondico = CreateObject("Scripting.dictionary") (cette ligne est en jaune )

For J = 3 To Nblg

Mondico(Range("F" & J).Value) = ""

Next J

Range("K1") = Range("F2")

For Each DicoKey In Mondico.keys

Ws.Range("K2") = DicoKey

If FeuilleExiste(CStr(DicoKey)) = False Then

Sheets.Add(after:=Sheets(Sheets.Count)).Name = DicoKey

End If

With Sheets(DicoKey)

.Cells.Clear

Ws.Range("A2:I" & Nblg).AdvancedFilter Action:=xlFilterCopy, criteriarange:=Ws.Range("K1:K2"), copytorange:=.Range("A1:I1")

End With

Next DicoKey

With Ws

.Range("K1:K2").ClearContents

.Select

End With

End Sub

Function FeuilleExiste(Nom As String) As Boolean

On Error Resume Next

FeuilleExiste = Sheets(Nom).Name <> ""

On Error GoTo 0

End Function

Bonsoir

Sur quelle ligne l'erreur ?

Quel est le message de l'erreur ?

ligne 9 " Set Mondico = CreateObject("Scripting.dictionary")"

le message c'est run-time error '429'

ActiveX component can't create object.

Bonjour

Peut-être que les Mac n'aiment pas l'objet "dictionary"

Une autre version sans cet objet

Merci

ça marche très bien.

Seul problème ça ce n'était que pour avoir déjà une idée sur la macro.

je dois l'appliquer en réalité sur excel 2010.

et sur un fichier plus gros.

je ferai un copier collé; mais quels sont les éléments a changer en fonction de ma nouvelles base de donnée sur excel 2010.

Et autres question j'etais en train de penser s'il y avait moyen d'effectuer le filtre sur le meme feuille mais de facon a ce que quand on effectue une rechercheV par exemple ça me prenne uniquement les données du filtres et non les données du filtres en plus les valeurs cachées.

Merci d'avance

Bonjour

La zone à filtrer ainsi que la zone de réception : surtout les colonnes, car pour les lignes la macro s'adapte

La colonne contenant la période

Ensuite la zone des critères si ta base à plus de colonnes

Sub Filtre()
Dim J As Long, Nblg As Long
Dim Ws As Worksheet
Dim Tablo()
Dim I As Integer, Indice As Integer

  Application.ScreenUpdating = False
  Set Ws = ActiveSheet
  If Ws.FilterMode = True Then Ws.ShowAllData
  Nblg = Range("[surligner=#FF80BF]F" & Rows.Count).End(xlUp).Row

  ReDim Tablo(0)
  For J = 3 To Nblg
    For I = 0 To UBound(Tablo)
      If Tablo(I) = Range("[surligner=#FF80BF]F" & J) Then Exit For
    Next I
    If I > UBound(Tablo) Then
      ReDim Preserve Tablo(Indice)
      Tablo(Indice) = Range("[surligner=#FF80BF]F" & J)
      Indice = Indice + 1
    End If
  Next J

  Range("[surligner=#FFFF40]K1") = Range("[surligner=#FF80BF]F2")
  For I = 0 To UBound(Tablo)
    Ws.Range("[surligner=#FFFF40]K2") = Tablo(I)
    If FeuilleExiste(CStr(Tablo(I))) = False Then
      Sheets.Add(after:=Sheets(Sheets.Count)).Name = Tablo(I)
    End If
    With Sheets(Tablo(I))
      .Cells.Clear
      Ws.Range("A2:I" & Nblg).AdvancedFilter Action:=xlFilterCopy, criteriarange:=Ws.Range("[surligner=#FFFF40]K1:K2"), copytorange:=.Range("[surligner=#80FFFF]A1:I1")
    End With
  Next I
  With Ws
    .Range("[surligner=#FFFF40]K1:K2").ClearContents
    .Select
  End With
End Sub

Ensuite pour la fonction RECHERCHEV() elle tient compte de toutes les lignes

Fais l'expérience

très grand merci

désolé de te déranger encore une fois mais mon tableau n'arrive pas jusqu'a K alors K1:K2 c'est pour quoi au juste ça je comprends pas

Merci encore

Bonjour

Pour faire un filtre élaboré, que se soit par macro ou par excel, il y a besoin d'une zone pour noter les critères du filtre

Et le minimum est de 2 cellules (dans ce cas cela suffit)

Si tu n'y connais pas grand chose sur les filtres élaborés fais une recherche avec ton ami et tu trouveras beaucoup de renseignements sur eux

Exemple

http://office.microsoft.com/fr-fr/excel-help/filtrer-a-laide-de-criteres-elabores-HP010073942.aspx

merci

tu m'as rendu un grand service

Bonjour,

merci une fois encore pour ton aide hier.

ça a très bien marché mais cette fois j'ai refais la meme macro

et quand lance ma macro j'ai ce message: "compile error: sub or fonction not defined"

et je comprend pas pourquoi.

Merci pour votre aide

Bonjour,

merci une fois encore pour ton aide hier.

ça a très bien marché mais cette fois j'ai refais la meme macro

et quand lance ma macro j'ai ce message: "compile error: sub or fonction not defined"

et je comprend pas pourquoi.

Merci pour votre aide

Bonsoir

Avec la ligne en erreur cela serait une aide pour essayer de comprendre le pourquoi

Supposition gratuite

Une erreur dans un mot

exemple Sheet("...") à la place de Sheets("....")

mais c'est cette partie " FeuilleExiste" de cette ligne en dessous qui est soulignée.

alors que devrais-je faire ?

If FeuilleExiste(CStr(Tablo(I))) = False Then

Bonsoir

Tu n'as pas oublié de copier la fonction FeuilleExiste ?

voici le fichier peux tu me dire exactement ce que j'ai fais comme erreur même au niveau de ma zone de critère en jaune.

Merci

voici mon fichier pouvez vous regarder ce qui ne va pas? meme la zone de critère en jaune

merci

Bonsoir

Pas la peine que je regarde tu as fournis un fichier sans les macros

Enregistres ton fichiers avec les macros (extension .xlsm)

merci

et désolé je pensais avoir envoyer le fichier avec la macro

mais je pense avoir trouver mon error

du moins je pense

non en fait ça marche pas

voici le fichier de nouveau

au lieu de filtrer par period Q1, Q2, Q3 ça ne filtre que Q1

Bonjour

Regardes tu envoies toujours le fichier sans macros

Quand tu enregistres ton fichier (vérifies que c'est le bon fichier avec les macros)