VBA: Erreur d'exécution 1004

EDIT: voir directement le dernier post pour l'erreur 1004

Bonjour à tous!

Après de longues et infructueuses recherches je viens quémander l'aide des pros pour mon problème de macro.

J'ai un tableau de données qui comporte environ 500 lignes et 170 colonnes.

Je cherche à faire une macro qui sélectionnerai tous les enregistrements correspondants à un certains nombres de critères.

Les critères sont définis directement dans des cellules. J'ai simplement copier les en-têtes de champs sur une autre feuille et l'utilisateur rempli la cellule en dessous du ou des champs qu'il souhaite.

Pour l'instant j'arrive à faire une recherche sur le premier champ (colonne A), ou alors deux champs (colonne A et B). Cependant, comment prendre en compte les cas ou une cellule n'est pas remplie? Au début je pensais coder en dur en mettant un "if" pour chaque colonne mais ça ne fonctionne pas.

Il faudrait pouvoir identifier quels sont les champs renseignés par l'utilisateur, puis faire une recherche dans les colonnes correspondantes et enfin sélectionner toutes les lignes dont les critères de recherche sont remplis!

Je vous mets mon code:

Sub Filtres()
Worksheets("RCEL").Activate 'On cherche dans la feuille RCEL
  i = 20 'Première ligne de données de la feuille RCEL
  i_max = Range("A65536").End(xlUp).Row 'Dernière ligne de données de RCEL
  NombreLignes = i_max - i

Do While i <= i_max
    ' If Cell(i, 1).Value <> "" Then ' PAS UTILISEE
    If Cells(i, 1) = Sheets("Filtre").Range("A25") And Cells(i, 2) = Sheets("Filtre").Range("B25") Then
    MesLignes = MesLignes & i & ":" & i & ","
    End If

i = i + 1
Loop
  MesLignes = Left(MesLignes, Len(MesLignes) - 1)
  Sheets("RCEL").Range(MesLignes).Select

End Sub

Donc pour l'instant on voit que je fais une boucle qui passe en revue toutes les lignes et vérifie si les conditions de recherches sont satisfaites pour TOUS les critères. Cependant si l'utilisateur ne renseigne pas de critère pour la première colonne, le code ne va sélectionner aucune lignes alors que je voudrais qu'il bipasse ce critère là et cherche pour l'autre critère!

Aussi les données sont dans la feuille "RCEL" et les critères de recherches dans la feuille "Filtre"

J'espère avoir été assez clair!

J'ai aussi trouver ce code prometteur:

Private Sub Search_Click()
'Worksheets("RCEL").Activate 'On cherche dans la feuille RCEL
  Dim Ind As Integer, DLig As Long, Lig As Long
  Dim TabCrit() As String, NbCrit As Integer, NbFind As Integer
  ' Tableau des champs pas rapport au sens des colonnes
  TabCrit = Split("Dossier N°,Langue,Société,Author,Politesse,Nom", ",")
  ' Effacer la ListBox avant
  Me.ListBox1.Clear
  ' Avec la feuille
  With Sheets("RCEL")
    ' Mémoriser la dernière ligne remplie du tableau
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 20 To DLig
      ' Mettre le nombre de critères et le nombre de valeurs trouvées à ZERO
      NbCrit = 0: NbFind = 0
      ' Pour chaque critère
      For Ind = 0 To 5
        ' Si le critère de recherche a été renseigné
        If Me.Controls(TabCrit(Ind)) <> "" Then
          NbCrit = NbCrit + 1
          ' Si le critère ressemble au contenu de la cellule
          If UCase(.Cells(Lig, 2 + Ind)) Like UCase("*" & Me.Controls(TabCrit(Ind)) & "*") Then
            ' Comptabiliser le nombre de valeurs correspondantes
            NbFind = NbFind + 1
          End If
        End If
      Next Ind
      ' Si le nombre de critères rempli = le nombre de valeurs trouvées
      If NbCrit = NbFind Then
        ' Ajouter l'item
        Me.ListBox1.AddItem .Cells(Lig, 2)
        ' Pour chaque colonne
        For Ind = 1 To 5
          ' Ajouter les valeurs correspondantes
          Me.ListBox1.List(Me.ListBox1.ListCount - 1, Ind) = .Cells(Lig, 2 + Ind)
        Next Ind
      End If
    Next Lig
  End With
End Sub

Je n'arrive toutefois pas à comprendre où sont définis les critères de recherche!

Bonsoir,

Un fichier en exemple serait bien utile pour pouvoir trouver une solution

Bonne soirée

Bouben

Hello,

Merci de me le rappeler j'avais omis ce détail important!

Alors voilà, j'ai fait une feuille exemple qui comporte 6 entrées de données dans la feuille RCEL. Dans la feuille Filtre, les cellules en grosses bordures noires seront celles où l'utilisateur rentre ces critères.

L'idée c'est qu'il remplisse à sa guise ces cellules et que si elles sont remplies, la macro fait une sélection selon le(s) critère(s) de recherche.

J'espère que c'est assez claire sinon n'hésitez pas à demander plus de détails.

Hello,

Alors après quelques recherches, j'en suis arriver à ça:

Option Explicit

Sub Recherche_Critères()
Dim i As Integer, j As Byte, DerLig As Integer
Dim Contrôle_Dossier As Boolean, Contrôle_Langue As Boolean, Contrôle_Société As Boolean
Dim Drapeau As Boolean
Dim MesLignes

' UTILE SI L ON VEUT GARDER UN HISTORIQUE DE LA RECHERCHE
'If ActiveCell.Row < 3 Or ActiveCell.Column <> 1 Or ActiveCell = "" Then
    'MsgBox "La référence choisie n'est pas valide"
    'Exit Sub
'End If

    DerLig = Sheets("RCEL").Range("A" & Rows.Count).End(xlUp).Row

    For i = 20 To DerLig ' Lignes de la feuille 'RCEL'

        'Dossier N° ------------ Début
        If Sheets("Filtre").Range("A25") = "" Then
            Contrôle_Dossier = True
            GoTo Etiquette_Langue
        End If

       'Colonnes A
            If Sheets("Filtre").Range("A25") = Sheets("RCEL").Cells(i, 1) Then
                Contrôle_Dossier = True
                GoTo Etiquette_Langue
            End If

        'LOCALITES ------------ Fin

        'Langue ------------ Début
Etiquette_Langue:

        If Sheets("Filtre").Range("B25") = "" Then
            Contrôle_Langue = True
        End If

        'Colonnes B
            If Sheets("Filtre").Range("B25") = Sheets("RCEL").Cells(i, 2) Then
                Contrôle_Langue = True
            End If

        'Langue ------------ Fin

        'Résultat
        If Contrôle_Dossier = True And Contrôle_Langue = True Then
            MsgBox ("Le dossier " & Sheets("RCEL").Cells(i, 1) & " conviendrait à ce(s) critères")
            MesLignes = MesLignes & i & ":" & i & "," 'Stockage des lignes qui répondent au critère
            Drapeau = True
        End If

        Contrôle_Dossier = False
        Contrôle_Langue = False

    Next i

If Drapeau = False Then MsgBox "Aucun dossier correspondant aux critères (vérifier les critères)"

If MesLignes <> "" Then
MesLignes = Left(MesLignes, Len(MesLignes) - 1)
Sheets("RCEL").Range(MesLignes).Select
End If

End Sub

Alors l'identification des lignes qui correspondent aux critères fonctionnent et je peux désormais remplir un ou deux critères (je ferais les autres après une fois que le code marchera comme sur des roulettes)

J'ai toutefois une erreur d'exécution 1004 pour la ligne:

Sheets("RCEL").Range(MesLignes).Select

J'imagine que c'est la manière de définir MesLignes qui cloche. J'ai trouvé cette manière de procéder sur un autre post et j'ai voulu adapter. Dans la macro originelle, MesLignes n'était pas déclarer en début de Macro et cela fonctionnait mais là j'ai du la déclarer pour ne pas avoir d'erreur.

Merci de votre aide!

Bonjour!

Alors je viens apporter la réponse pour ceux que ça intéresserait! L'erreur venait d'un trop grand nombre de lignes sélectionnées (sélection multiple).

Du coup j'ai simplement coller les enregistrements correspondants dans une nouvelle feuille au fur et à mesure que la macro trouve des correspondances.

Je mets le code ici pour ceux que ça intéresserait! (j'ai laissé une variable, MesLignes, inutile mais qui me sert de contrôle lorsque j'ajoute de nouveaux critères de recherche).

Voilà il me reste donc à ajouter environ 120 critères

Sub Recherche_Critères()
Dim i As Integer, j As Byte, DerLig As Integer
Dim Contrôle_Dossier As Boolean, Contrôle_Langue As Boolean, Contrôle_Société As Boolean
Dim Drapeau As Boolean
Dim MesLignes As String
Dim k As Integer 'compteur des lignes à copier
Dim LignesCopy As String 'numéro de la ligne à copier

' SUPPRESSION DES DONNES SELECTIONNEES LORS D'UNE UTILISATION PRECEDENTES
    Sheets("Selection").Select
    Rows("20:20").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
' -----------------------------------------------------------------------

    DerLig = Sheets("RCEL").Range("A" & Rows.Count).End(xlUp).Row

    k = 20 'initialisation du compteur au numéro de la première ligne (i.e. 20)
    For i = 20 To DerLig ' Lignes de la feuille 'RCEL'

        'Dossier N° ------------ Début
        If Sheets("Filtre").Range("A25") = "" Then
            Contrôle_Dossier = True
            GoTo Etiquette_Langue
        End If

       'Colonnes A
            If Sheets("Filtre").Range("A25") = Sheets("RCEL").Cells(i, 1) Then
                Contrôle_Dossier = True
                GoTo Etiquette_Langue
            End If

        'LOCALITES ------------ Fin

        'Langue ------------ Début
Etiquette_Langue:

        If Sheets("Filtre").Range("B25") = "" Then
            Contrôle_Langue = True
        End If

        'Colonnes B
            If Sheets("Filtre").Range("B25") = Sheets("RCEL").Cells(i, 2) Then
                Contrôle_Langue = True
            End If

        'Langue ------------ Fin

        'FACADE ------------ Début
'Etiquette_FACADE:
        'If .Cells(i, 7) >= Range("R" & ActiveCell.Row) Then Contrôle_Façade = True
        'FACADE ------------ Fin

        'DIMENSION ------------ Début
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Etiquette_DIMENSION:
        'DIMENSION ------------ Fin

        'Résultat
       If Contrôle_Dossier = True And Contrôle_Langue = True Then

            If Trim("" & MesLignes) = "" Then
                MesLignes = i & ":" & i    'Stockage des lignes qui répondent au critère
            Else
            MesLignes = MesLignes & "," & i & ":" & i  'Stockage des lignes qui répondent au critère
            End If
            LignesCopy = i & ":" & i
            Sheets("RCEL").Range(LignesCopy).copy Sheets("Selection").Range("A" & k)
            k = k + 1
            Drapeau = True
        End If

        Contrôle_Dossier = False
        Contrôle_Langue = False
        'Contrôle_Façade = False

    Next i

If Drapeau = False Then MsgBox "Aucun dossier correspondant aux critères (vérifier les critères)"

If Trim("" & MesLignes) <> "" Then
    Worksheets("Selection").Activate
    MsgBox ("Mes lignes " & MesLignes)
End If

End Sub

Et pour le coup, je remercie moi-même d'avoir apporté une réponse à la problématique!

Bonne continuation.