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 |
