Recherche via une macro

Question

Cela fait quelques jours que je me creuse la tête et que je fais des recherches pour résoudre mon problème mais rien n'y fait donc je décide de vous demander de l'aide. Je vous expliques: Je souhaiterais écrire une macro qui me permette de m'emmener à la ligne voulu (afin d'éviter de scroll sur un long tableau). J'ai créé un bouton à partir du quel je lance la macro de recherche, j'ai également une liste déroulante qui me permet de choisir un argument pour ma recherche (ici ce sera le nom d'un bâtiment). Derrière les deux boutons de recherches il y a une formule EQUIV afin de connaitre les numéros de lignes en fonction des arguments des listes. voici une petite photo de ce que ca donne...

ThauThème · Answer

Et pourquoi une capture d'écran et pas directement le fichier ?!... L'autre jour je crève. J'apporte une photo de mon pneu crevé au garagiste.Il n'a pas pu me le réparer. C'est couillon non ?!.....

ThauThème · Answer

Re,

En pièce jointe ton fichier modifié avec les codes des boutons ci-dessous :

Sub recherche1()
Dim S As Worksheet
Dim R As Worksheet
Dim TV As Variant

Set S = Worksheets("Synthese")
Set R = Worksheets("Résultat")
R.Rows(9 & ":" & Application.Rows.Count).Delete
R.Range("H8:I8").Delete
TV = S.Range("A6").CurrentRegion
For I = 2 To UBound(TV, 1)
    If UCase(TV(I, 2)) = "2 ET 3" And TV(I, 3) = S.Range("I3").Value Then
        DL = I + 5 + S.Cells(I + 5, 3).MergeArea.Cells.Count - 1
        S.Range(S.Cells(I + 5, "B"), S.Cells(DL, "G")).Copy R.Range("B9")
        S.Range("H3:I3").Copy R.Range("H8")
        Exit For
    End If
Next I
R.Activate
End Sub

Sub recherche2()
Dim S As Worksheet
Dim R As Worksheet
Dim TV As Variant

Set S = Worksheets("Synthese")
Set R = Worksheets("Résultat")
R.Rows(9 & ":" & Application.Rows.Count).Delete
R.Range("H8:I8").Delete
TV = S.Range("A6").CurrentRegion
For I = 2 To UBound(TV, 1)
    If UCase(TV(I, 2)) = "4 ET 5" And TV(I, 3) = S.Range("I4").Value Then
        DL = I + 5 + S.Cells(I + 5, 3).MergeArea.Cells.Count - 1
        S.Range(S.Cells(I + 5, "B"), S.Cells(DL, "G")).Copy R.Range("B9")
        S.Range("H4:I4").Copy R.Range("H8")
        Exit For
    End If
Next I
R.Activate
End Sub

8bradeau-v01.xlsm (41.34 Ko)