Erreurs sur filtres avancés

Bonsoir ,

Pourrait-on m'expliquer où se trouve l'erreur dans le filtre avancé fournis dans ce fichier excel. En effet je tente de trier automatiquement une plage de données en modifiant les critères d'une autre plage or une erreur 1004 intervient. Quelqu'un pour m'aider s'il vous plait?

Le fichier étant trop volumineux voici le code présent :

Private Sub Worksheet_Change(ByVal Target As Range)

Call Advanced_FilteringASJ_DOCUMENTS_MANQUANTS_PEC
Call Advanced_FilteringASJ_Début_régulariser

End Sub

Public Sub Advanced_FilteringASJ_DOCUMENTS_MANQUANTS_PEC()
 Dim LastRow As Long
 Dim rng As Range
Set rng = Sheets("NEPASTOUCHER").Range("A1:G8")

For i = 3 To Last(1, rng) 'Loops through until the last Row
  RowsCount = Application.WorksheetFunction.CountA(Sheets("NEPASTOUCHER").Range("A" & i & ":G" & i))
  If RowsCount = 0 Then CriteriaRowsSet = i - 1 Else CriteriaRowsSet = i 
Next i

Sheets("TABLEAU DE SUIVI").Range("A1:AG10000").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("NEPASTOUCHER").Range("A2:G" & CriteriaRowsSet), _
CopyToRange:=Sheets("ASJ AVEC DOCUMENTS MANQUANTS").Range("A3:G3")

End Sub

Public Sub Advanced_FilteringASJ_Début_régulariser()

 Dim LastRow As Long
 Dim rng As Range
Set rng = Sheets("NEPASTOUCHER").Range("A1:G8")

For i = 3 To Last(1, rng) 'Loops through until the last Row
  RowsCount = Application.WorksheetFunction.CountA(Sheets("NEPASTOUCHER").Range("J" & i & ":O" & i))
  If RowsCount = 0 Then CriteriaRowsSet = i - 1 Else CriteriaRowsSet = i
Next i

Sheets("TABLEAU DE SUIVI").Range("A1:AG10000").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("NEPASTOUCHER").Range("J2:O" & CriteriaRowsSet), _
CopyToRange:=Sheets("ASJ DEBUT A REGULARISER").Range("B2:G2")

End Sub

Function Last(choice As Long, rng As Range)
' 1 = last row
' 2 = last column
' 3 = last cell
    Dim lrw As Long
    Dim lcol As Long

    Select Case choice

    Case 1:
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        On Error GoTo 0

    Case 2:
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

    Case 3:
        On Error Resume Next
        lrw = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
        On Error GoTo 0

        On Error Resume Next
        lcol = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

        On Error Resume Next
        Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
        If Err.Number > 0 Then
            Last = rng.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0

    End Select
End Function

Bonjour,

difficile de répondre sans voir le fichier excel

Sheets("TABLEAU DE SUIVI").Range("A1:AG10000").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("NEPASTOUCHER").Range("J2:O" & CriteriaRowsSet), _
CopyToRange:=Sheets("ASJ DEBUT A REGULARISER").Range("B2:G2")

Les noms des feuilles et les en-têtes de colonne sont-elles bien orthographiées ?

Quelle est la valeur de CriteriaRowsSet, fais un msgbox ou un debug.print juste avant l'application du filtre avancé.

Les en-têtes des critères sont en ligne 2 ? idem pour les résultats ?

Utilise plutôt CurrentRegion, tu n'auras pas à calculer le nombre de lignes.

Structure aussi tes données en tableau pour ne pas avoir à prévoir 100000 lignes

Exemple plus simple

    Sh0.Range("donnees[#All]").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sh1.Range("A1").CurrentRegion, _
        CopyToRange:=Sh2.Range("A4").CurrentRegion.Resize(1), Unique:=False

Ca ne marche toujours pas.

Ah ben voilà, il aurait fallu donner ton fichier plus tôt.

Il y a pas mal d'erreurs à corriger.

1- D'abord une instruction en rouge !!

2- la même macro présente dans 2 endroits différents, avec le même nom

3- l'emploi de CurrentRegion alors que les critères ou données extraites sont juxtaposées avec des titres qui n'ont rien à voir

Je vais tenter d'éclaircir tout cela demain ! et réduire la base de données en supprimant les lignes vierges.

Correction :

• il faut isoler la zone de critères (pas de cellules renseignées adjacentes)
• ne pas ajouter de lignes inutiles à un tableau
• mettre les macros à l'activation des onglets de données extraites

Merci encore! Ton fichier fonctionne pas mal sauf qu'il y a toujours quelque chose qui bloque quand je le fais moi même c'est à en devenir fou.

Hé oui ... Nom n'existe pas dans ton tableau de suivi !

Il y a Nom de naissance et Nom d'usage, mais pas Nom

Steelson a écrit :

Les noms des feuilles et les en-têtes de colonne sont-elles bien orthographiées ?

Super sujet resolu je suppose. Je devrais faire plus attention. Il y a t il un tuto pour apprendre les arguments de chaque fonction?

Une manière assez facile (dans ce cas présent des filtres) est de faire une maquette de macro par apprentissage.

Mais cela ne résout pas le problème d'aligner parfaitement les libellés de colonne.