Discussion :

[Armoric22]

Bonjour à tous,

Je cherche à récupérer les informations de plusieurs onglets dans une feuille "recap".

J’ai un fichier excel de 10 onglets :
Dans 9 onglets, j'ai des informations sur de nombreux candidats. Un par ligne. Les numéros de candidats apparaissent colonne A et les autres informations entre les colonnes B et K. Chaque onglet correspond à une zone géographique différente.

Dans le 10e onglet « recap », j’aimerais récupérer toutes les informations grâce à une fonction vba de recherche. Le critère de recherche est le N° colonne A de la feuille «recap ». (Est-ce qu'il est possible par exemple de coller toute la ligne quand le N° correspond)

Pourriez-vous m’aider à effectuer cette recherche ? J’ai récupéré et essayé d’adapter une macro trouvée sur le net mais ça ne marche pas.
Merci beaucoup.
JB
Ci-joint, le fichier.

[Invité]

Bonjour,

A tester :

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
47
48
49
50
 
Option Explicit
 
Sub Recherche3()
 
Dim ShRecap As Worksheet, OngletEnCours As Worksheet
Dim MesOnglets As Variant
Dim I As Long, J As Long, DerniereLigne As Long
Dim AireRecap As Range, CelluleRecap As Range
Dim AireOnglet As Range, CelluleOnglet As Range
Dim Continuer As Boolean
 
    Set ShRecap = Sheets("RECAP")
    MesOnglets = Array("A", "B", "C", "D", "E", "F", "G", "H", "I")
 
    Application.ScreenUpdating = False
    With ShRecap
         DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
         Set AireRecap = .Range(.Cells(2, 1), .Cells(DerniereLigne, 1))
         For Each CelluleRecap In AireRecap
             Continuer = True
             For I = LBound(MesOnglets, 1) To UBound(MesOnglets, 1)
                 If Continuer = True Then
                    Set OngletEnCours = Sheets(MesOnglets(I))
                    With OngletEnCours
                         DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
                         Set AireOnglet = .Range(.Cells(2, 1), .Cells(DerniereLigne, 1))
                         For Each CelluleOnglet In AireOnglet
                             If CelluleRecap = CelluleOnglet Then
                                .Range(CelluleOnglet, CelluleOnglet.Offset(0, 10)).Copy Destination:=CelluleRecap
                                ShRecap.Hyperlinks.Add Anchor:=CelluleRecap.Offset(0, 11), Address:="", SubAddress:=OngletEnCours.Name & "!" & CelluleOnglet.Address
                                Continuer = False
                                Exit For
                             End If
                         Next CelluleOnglet
                         Set AireOnglet = Nothing
                    End With
                    Set OngletEnCours = Nothing
                 End If
 
             Next I
         Next CelluleRecap
 
    End With
    Set ShRecap = Nothing
    Application.ScreenUpdating = True
 
    MsgBox "Fin de mise à jour !", vbInformation
 
End Sub

Le 194269 : mort aux pluches....

[Armoric22]

Bonjour,
Vous êtes un pro ! C'est vraiment génial! Ça marche du tonnerre. Merci.
Cordialement,
JB