Recherche de lignes sur plusieurs feuilles

**Warthill** · 04/12/2013, 12h44

Bonjour a tous,

Je suis débutant en langage VBA et je maîtrise pas complètement Excel.
Cependant, je suis très curieux à ce sujet, et j'ai envie d’apprendre.
C'est pourquoi je me permet de venir poser ma question ici alors que je n'ai quasiment pas eu de formation, mise à pars quelques cours.

Dans le cadre de mon travail, nous avons dressé un fichier excel regroupant tout nos contacts (fournisseurs/sous traitants).
Ceux-ci sont classés sur différentes feuilles principalement par domaine d'activité.

Aujourd'hui, je voudrais pouvoir effectuer une recherche dans ces différentes feuilles suivant plusieurs critères (Domaine/poste occupé ...).
Et j'aimerais que cette recherche se situe sur une feuille à pars, et quelle m'affiche le résultat directement sur cette feuille.

J'ai déjà passé plusieurs heures à chercher des solutions. J'ai réussis cela en grande partie grâce a un filtre élaboré sous forme de macro pour qu'il soit automatisé à l'aide d'un bouton. Mais je n'avais pas réussi à allé chercher les infos sur d'autres feuilles, ni à recopier les résultats sur une autre feuille.

En espérant avoir été clair. Je vous transmet un exemple de mon fichier

**Daniel.C** · 04/12/2013, 13h28

Bonjour,

J'ai mis cette macro dans le module de la feuille "MENU". Quand tu saisis quelque chose dans la zone de recherche, la recherche se déclenche automatiquement.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Sh As Worksheet, C As Range, Ligne As Long, Col As Integer, Ctr As Integer
    If Intersect(Target, [B4:H4]) Is Nothing Then Exit Sub
    [A8:H10000].ClearContents
    Ligne = 7
    For Each Sh In Worksheets
        If Sh.Name <> "MENU" Then
            With Sh
                For Each C In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
                    Ctr = 0
                    For Col = 1 To 5
                        If Cells(Target.Row, Col + 1) = .Cells(C.Row, Col) Or Cells(Target.Row, Col + 1) = "" Then
                            Ctr = Ctr + 1
                        End If
                    Next Col
                    If Ctr = 5 Then
                        Ligne = Ligne + 1
                        Application.EnableEvents = False
                        Sheets("MENU").Cells(Ligne, 2).Resize(, 7).Value = _
                            .Cells(C.Row, 1).Resize(, 7).Value
                        Application.EnableEvents = True
                    End If
                Next C
            End With
        End If
    Next Sh
End Sub

Si tu débutes, il est normal que tu te poses des questions. Si le code te convient, j'y mettrais des explications.

**Warthill** · 04/12/2013, 15h11

Super! Merci beaucoup!

C'est déjà un bon début. Je ne pensais pas que ce serais aussi compliqué.
Et si tu veux bien, je serais friand de quelque explication. Personnellement j'avais essayé en adaptant la macro du filtre élaboré, mais sans grand résultat.

Maintenant, est-il possible d'aller chercher les éléments sur plusieurs autre feuilles?
En effet, le document en PJ n'est qu'une infime partie du document réel. J'ai en réalité 7 pages, et parfois plus de 200 lignes par page.
Je voudrais à l'aide d'une feuille appelé "MENU" chercher les lignes correspondant au critères sur plusieurs feuilles différentes. Et de mettre le résultat sur la feuilles "MENU".

Merci pour ton attention. Je vais essayé de comprendre le code que tu m'as donné de mon coté!

Edit: Est-il possible de ne pas voir les différentes lignes avant d'avoir fais la recherche?

**Daniel.C** · 04/12/2013, 16h56

Maintenant, est-il possible d'aller chercher les éléments sur plusieurs autre feuilles?

Oui; si tu entres seulement "Olivier" en F4 tu récupères une ligne de chaque feuille (il faut que tu modifies un nom; tu as écrit "Olivier "). Je te joins le code commenté.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
'Cette macro se déclenche quand on entre une valeur dans une cellule
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Sh As Worksheet, C As Range, Ligne As Long, Col As Integer, Ctr As Integer
    'si la cellule modifiée ne fait pas partie de la plage B4:H4, on arrête la macro.
    If Intersect(Target, [B4:H4]) Is Nothing Then Exit Sub
    'Effacement de la plage A8:H10000
    [A8:H10000].ClearContents
    'La variable "Ligne" va servir à déterminer où écrire le résultat
    Ligne = 7
    'Boucle les feuilles
    For Each Sh In Worksheets
        '... sauf sur la feuille MENU
        If Sh.Name <> "MENU" Then
            'tout ce qui commence par un point se réfère à "Sh"
            With Sh
                'pour chaque cellule de la plage des cellules noon vides de la colonne A
                For Each C In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
                    '"Ctr" sert à compter les égalités ligne en cours - cellules de recherche
                    Ctr = 0
                    'comparaison des 5 cellules; on incrémente Ctr en cas d'égalité
                    'ou si la cellule de la zone de recherche est vide
                    For Col = 1 To 5
                        If Cells(Target.Row, Col + 1) = .Cells(C.Row, Col) Or Cells(Target.Row, Col + 1) = "" Then
                            Ctr = Ctr + 1
                        End If
                    Next Col
                    'si on n'a que des égalités
                    If Ctr = 5 Then
                        'on incrémente le n° de ligne où on va écrire le résultat
                        Ligne = Ligne + 1
                        'cette ligne évite de redéclencher la macro puisqu'on va écrire sur la feuille
                        Application.EnableEvents = False
                        'éccriture du résultat
                        Sheets("MENU").Cells(Ligne, 2).Resize(, 7).Value = _
                            .Cells(C.Row, 1).Resize(, 7).Value
                        'cette ligne permet le redéclenchement de la macro quand on réécrira sur la feuille
                        Application.EnableEvents = True
                    End If
                'traitement de la cellule suivante
                Next C
            End With
        End If
    'traitement de la feuille suivante
    Next Sh
End Sub

**Warthill** · 04/12/2013, 17h27

Je comprend déjà beaucoup mieux! Je te remercie du temps passé!

Quelque petites questions:

- "" veut dire que la cellule est vide?
- Avec ta macro, il faut impérativement que le texte écrit dans la recherche soit exactement celui présent dans les cellules analyser?
- y aura t-il toujours le tableau présent même si aucune recherche n'est effectué? (Car pour quelque lignes ça va, mais si les 500 lignes de mon doc doivent y figurer, ça risque de ralentir tout?)

Je vais donc essayé de l'appliquer à mon document officiel. Je te tiens au courant!

Encore un grand merci!

**Daniel.C** · 04/12/2013, 17h48

- "" veut dire que la cellule est vide?

Juste.

- Avec ta macro, il faut impérativement que le texte écrit dans la recherche soit exactement celui présent dans les cellules analyser?

Telle qu'elle écrite, oui. Ça peut se modifier.

- y aura t-il toujours le tableau présent même si aucune recherche n'est effectué? (Car pour quelque lignes ça va, mais si les 500 lignes de mon doc doivent y figurer, ça risque de ralentir tout?)

Je ne comprends pas ce que tu veux dire. Peux-tu préciser ?

**Warthill** · 04/12/2013, 18h45

Est-il compliqué de modifier la façon de rechercher les mots? Peut on faire une recherche sans que les termes sois exactement les mêmes?
Cela serait idéal, si ce n'est pas compliqué. Sinon, le programme tel-quel me va très bien!

C'est pas grave pour ma dernière question, c'étais d'un point de vue purement esthétique, et finalement, ça rend bien.

Donc j'ai réussi très facilement à adapter ta macro à mon fichier complet. Et cela marche super bien! Tu viens de me libérer de deux semaines de boulots avant d'arriver à ce résultat la (Et encore!)

J'aurais une dernière petite question: est-ce possible de copier en même temps que les infos, la mise en page des cellules. Plus simplement: si la cellule "domaine" recherché est de couleur rouge, lorsqu'elle s'affiche sur la page MENU, quelle soit aussi de couleur rouge?

**Daniel.C** · 05/12/2013, 11h23

Bonjour,

La macro fait une recherche partielle dans les cellules; Ainsi, si tu recherches "Olivier", elle trouvera "Olivier ". J'ai également pris en compte la mise en forme.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
'Cette macro se déclenche quand on entre une valeur dans une cellule
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Sh As Worksheet, C As Range, Ligne As Long, Col As Integer, Ctr As Integer
    'si la cellule modifiée ne fait pas partie de la plage B4:H4, on arrête la macro.
    If Intersect(Target, [B4:H4]) Is Nothing Then Exit Sub
    'Effacement de la plage A8:H10000
    [A8:H10000].ClearContents
    If Application.CountA([B4:H4]) = 0 Then Exit Sub
    'La variable "Ligne" va servir à déterminer où écrire le résultat
    Ligne = 7
    'Boucle les feuilles
    For Each Sh In Worksheets
        '... sauf sur la feuille MENU
        If Sh.Name <> "MENU" Then
            'tout ce qui commence par un point se réfère à "Sh"
            With Sh
                'pour chaque cellule de la plage des cellules noon vides de la colonne A
                For Each C In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
                    '"Ctr" sert à compter les égalités ligne en cours - cellules de recherche
                    Ctr = 0
                    'comparaison des 5 cellules; on incrémente Ctr en cas d'égalité
                    'ou si la cellule de la zone de recherche est vide
                    For Col = 1 To 5
                        If InStr(1, .Cells(C.Row, Col), Cells(Target.Row, Col + 1)) > 0 Or _
                            Cells(Target.Row, Col + 1) = "" Then
                            Ctr = Ctr + 1
                        End If
                    Next Col
                    'si on n'a que des égalités
                    If Ctr = 5 Then
                        'on incrémente le n° de ligne où on va écrire le résultat
                        Ligne = Ligne + 1
                        'cette ligne évite de redéclencher la macro puisqu'on va écrire sur la feuille
                        Application.EnableEvents = False
                        'éccriture du résultat
                        .Cells(C.Row, 1).Resize(, 7).Copy Sheets("MENU").Cells(Ligne, 2)
                        'cette ligne permet le redéclenchement de la macro quand on réécrira sur la feuille
                        Application.EnableEvents = True
                    End If
                'traitement de la cellule suivante
                Next C
            End With
        End If
    'traitement de la feuille suivante
    Next Sh
End Sub

**Warthill** · 05/12/2013, 14h58

Un grand grand merci Daniel! C'est exactement ce que je recherchais!
J’espère un jour maîtriser autant que toi ce logiciel!

J'affiche le problème comme résolue.

A la prochaine avec plaisir,

Recherche de lignes sur plusieurs feuilles [XL-2007]

Conception

Discussions similaires

Partager

Partager