Bouton Recherche Par VBA

Bonjour à Tous & Bonjour le Forum.

Si je suis sur ce Forum Merveilleux c’est que je n’arrive pas à résoudre ce problème.
Voila, Actuellement je fais mes recherche par le bouton Recherche de l’onglet accueil “Édition” Mais le problème dans mes recherches je n’ai pas une trace de mon résultat

Voila ma demande si c’est possible je veux faire une recherche par une macro dans toutes les feuilles"chaque feuille ou Onglet si on veut est une journée comptable et pour chaque recherche mon compteur doit faire une recherche de 365 X le nombres d’années et m’écrit le résultat dans l’onglet résultat.
Et Voici un Exemple du Résultat Voulu.

Merci Beaucoup et je suis a votre entière disposition s’il y a une question

Merci encore.Journal De Caisse.xlsm.xlsm (442,4 Ko)

Bonjour,

Si j’ai compris la demande, une macro dans la feuille “Résultat”

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ws As Worksheet, Wd As Worksheet, Dl%, i%, j% 'Déclaration des variables
Application.EnableEvents = False
Application.ScreenUpdating = False 'Désactive le rafraissement Ecran
Range("A2:D65000").ClearContents 'nettoie la feuille Résultat
j = 2
Set Wd = Sheets("Résultat")
  For Each Ws In Worksheets 'Boucle sur les onglets
    If Ws.Name <> "Résultat" And Ws.Name <> "Tableau" Then 'sauf l'onglet de Résultat et Tableau
    Sheets(Ws.Name).Activate 'Active l'onglet
    Set Ws = Sheets(Ws.Name)
    Dl = Ws.Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
      For i = 13 To Dl 'boucle sur les lignes
        If Replace(Ws.Cells(i, 2).Value, " ", "") = Wd.Cells(1, 8).Value Then 'si la cellue colonne "I" est égale à la recherche sans espace dans le mot
          Wd.Cells(j, 1).Value = Ws.Cells(i, 1).Value 'Copie la date
          Wd.Cells(j, 2).Value = Ws.Cells(i, 2).Value 'Copie le libellé
          Wd.Cells(j, 3).Value = Ws.Cells(i, 4).Value 'Copie l'entrée
          Wd.Cells(j, 4).Value = Ws.Cells(i, 6).Value 'Copie la sortie
          j = j + 1 'ajoute 1 au compteur de ligne
        End If
      Next i
      End If
  Next Ws
  Sheets("Résultat").Activate
  Range("A2").Select
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

La recherche se fait sur le nom du client sur la liste déroulante en H1
Journal De Caisse.xlsm.xlsm (459,2 Ko)

Bonjour Mimimathy
Voila ce que j’appelle du travail bien soigné,Je vous remercie infiniment car c’est le résultat voulu et si ce n’est trop vous demandez qu elle est l’intérêt des deux dernières lignes merci

Application.EnableEvents = True
Application.ScreenUpdating = True

Merci beaucoup Mimimathy

Re,
L’intêret:

Si tu regardes la macro, ces deux lignes sont présentent en début de code, mais à FALSE
le ScreenUpdating pour éviter le passage d’onglet à onglet (Rafraîchissement d’écran + Gain de vitesse)
le deuxième EnableEvents pour éviter le recalcul à chaque modification si celui-ci est déjà effectué

Après la touche F1 de ton clavier te conduira à des explications complémentaires :wink:

Rebonjour Mimimathy

Trés bien saisie, génial je vais écrire les commentaires a coté des codes VBA.

c’est trés bien j’apprends.
Et si je ne vous ennuie pas trop je reviendrai si je bloque sur autres choses
Je vous tire Chapeau
Encore Merci Mimimathy "

Trés Bonne Continuation.

Merci

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.