Moteur de recherche multi-onglets

Bonsoir,

J'aimerais m'inspirer d'un moteur de recherche, trouvé sur le forum, le rafraîchir et l'adapter sur un planning évènementiel.

Sur le modèle joint, pourriez-vous m'apporter votre aide; un moteur de recherche permet d'exploiter une petite base de données.

Supposons que la base de données conserve la même architecture sur une quarantaine de feuilles, où seul les données inscrites diffèrent.

Sauriez-vous modifier en conséquence les lignes de commande, pour que le moteur de recherche assure son investigation sur l'intégralité des onglets, comme il le fait jusqu'alors pour un fichier unique.

Je vous remercie par avance.

Marco

Bonjour

A tester

Merci Banzaï, d'avoir apporter un élément de réponse.

Permets-moi d'ajouter ce petit complément d'information.

Si en lieu et place de BDD... et suivants, comme tu l'as mentionné dans les commandes "BBD*", nous avions une suite d'onglets, numérotés de 01 à 31, quel commande faudrait-il ajouter et ou modifier.

La méthode empirique pour comprendre le VBA, comme je le fais, n'est peut être pas la bonne pour progresser.

Merci

Banzai64 a écrit :

Bonjour

A tester

Bonjour

Remplaces la macro actuelle par celle-ci

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim DLig As Long, ShtR As Worksheet
Dim Ligne As Long
Dim I As Integer

  ' Sort de la procédure si le nombre de cellules modifiées > 1
  If Target.Count > 1 Then Exit Sub
  ' Si la modification n'est pas effectuée dans une des 2 cellules B1:B2, on sort
  If Intersect(Target, Range("A3:O3")) Is Nothing Then Exit Sub
  ' Sinon
  ' inscrire le critère correctement
  Application.EnableEvents = False
  If Target.Value <> "" Then
    If Not IsDate(Target) Then
      Target = "*" & Replace(Target, "*", "") & "*"
    End If
  End If
  Application.EnableEvents = True
  Application.ScreenUpdating = False
  ' Définir la feuille contenant les critères de recherche
  Set ShtR = Sheets("Recherche")
  Range("A4:O" & Application.Max(4, Range("A" & Rows.Count).End(xlUp).Row)).Clear
  If Application.CountA(Range("A3:O3")) = 0 Then Exit Sub
  For I = 1 To 31
    With Sheets(Format(I, "00"))
      Ligne = Application.Max(3, Range("A" & Rows.Count).End(xlUp).Row) + 1
      ' Supprimer le filtrage
      On Error Resume Next
      .ShowAllData
      On Error GoTo 0
      ' Trouver le numéro de la dernière ligne remplie
      DLig = .Range("A" & Rows.Count).End(xlUp).Row
      ' Filtrer les lignes
      .Range("A1:O" & DLig).AdvancedFilter Action:=xlFilterCopy, _
                                           CriteriaRange:=ShtR.Range("A2:O3"), Unique:=False, copytorange:=Range("A" & Ligne).Resize(1, 15)
      Rows(Ligne).Delete
    End With
  Next I
End Sub

Merci Banzaï,

Cela marche parfaitement.

Cela me sera d'une aide précieuse. Ce moteur de recherche sera un outil sollicité constamment.

Bon weekend.

Marco