Consolidation des données

Bonjour,

Je veux savoir comment je peux coller les résultats trouver dans le même classeur et dans la feuille <<b2301>> a partir de LA CELLULE A3.En gros je ne veux pas que le programme m'ouvre un nouveau classeur, je veux que ca soit sur la feuille <<b2301>>cellule A3 de mon classeur actuel.

Sub recherche()

'twb fait référence au classeur en cours
Set twb = ThisWorkbook
Dim resultat As String
' on demande le Lio"
resultat = InputBox("Entrer numéro de LIO :", "Titre") 'La variable reçoit la valeur entrée dans l'InputBox

If resultat <> "" Then 'Si la valeur est différente de "" on affiche le résultat
MsgBox "Le LIO recherché est " & resultat
End If
' on va parcourir un à un toutes les feuilles du classeur en cours, ws identifie chacune de ces feuilles
i = 0
For Each WS In twb.Worksheets
' on recherche le lio dans la feuille ws
Set trouve = WS.Cells.Find(resultat, LookIn:=xlValues, LookAt:=xlWhole)

If Not trouve Is Nothing Then
pAddresse = trouve.Address

If i = 0 Then Set nwb = Workbooks.Add

Do
i = i + 1
WS.Rows(trouve.Row).Copy nwb.Sheets(1).Range("A" & i)
nwb.Sheets(1).Cells(i, "E").Value = WS.Name 'pour copier le nom de l'onglet d'ou provient cette ligne
Set trouve = WS.Cells.FindNext(trouve)
Loop While Not trouve Is Nothing And trouve.Address <> pAddresse
End If

' on passe au classeur suivant
Next
If i = 0 Then
MsgBox "lio non trouvé"
End If
End Sub

Edit : merci de mettre le code entre balises grâce au bouton </>

Je mets le classeur en PJ.

Cela m'aidera pour mon PFE .

Merci d'avance.

Bonjour bilel et

Une petite présentation ICI pourrait être sympa

Voici le code modifié, tu semble confondre Workbook et Worksheet

Sub RechercheLIO()
  Dim Twb As Workbook, Ws As Worksheet, Nwb As Worksheet
  Dim Trouve As Range
  Dim sLio As String, MemAddress As String
  Dim Ind As Integer, nLig As Long
  'twb fait référence au classeur en cours
  Set Twb = ThisWorkbook
  ' on demande le Lio"
  sLio = InputBox("Entrer numéro de LIO :", "Titre")    'La variable reçoit la valeur entrée dans l'InputBox
  If sLio <> "" Then    'Si la valeur est différente de "" on affiche le résultat
    MsgBox "Le LIO recherché est " & sLio
  End If
  ' on va parcourir un à un  toutes les feuilles du classeur en cours, ws identifie chacune de ces feuilles
  Ind = 0:
  For Each Ws In Twb.Worksheets
    ' Si le nom de la feuille ne comence pas par "b" on passe
    If Left(Ws.Name, 1) = "b" Then GoTo SuiteWs
    ' Initialiser la variable
    MemAddress = ""
    ' on recherche le lio dans la feuille ws
    Set Trouve = Ws.Cells.Find(sLio, LookIn:=xlValues, LookAt:=xlWhole)
    If Trouve Is Nothing Then GoTo SuiteWs
    ' Sinon mémoriser l'adresse de la 1ère cellule trouvée
    MemAddress = Trouve.Address
    ' Chercher la valeur
    Do While Not Trouve Is Nothing
      ' Incrémenter le nombre de valeurs trouvées
      Ind = Ind + 1
      ' définir la feuille selon Lio cherché
      Set Nwb = Twb.Sheets("b" & sLio)
      ' nouvelle ligne vierge
      nLig = Nwb.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
      ' copier les valeurs
      Ws.Rows(Trouve.Row).Copy Destination:=Nwb.Range("A" & nLig)
      Nwb.Range("E" & nLig).Value = Ws.Name
      'Nwb.Cells(nLig, "E").Value = Ws.Name             'pour copier le nom de l'onglet d'ou provient cette ligne
      Set Trouve = Ws.Cells.FindNext(Trouve)
      ' Si on est revenu à la première cellule
      If Trouve.Address = MemAddress Then Exit Do
    Loop
    ' on passe à la feuille suivants
SuiteWs:
  Next Ws
  ' Vérification
  If Ind = 0 Then
    MsgBox "lio non trouvé"
  Else
    MsgBox "Inscription des données pour LIO : " & sLio & ", terminée", vbInformation, "C'EST FINI..."
  End If
End Sub

@+

Bonjour Mr,

je viens d'essayer votre code et je vous remercie infiniment pour ce programme qui marche mieux que je l'imaginais.

Dans le cadre de la même projet il est demandé de donner un récapitulatif pour un employé dont on sélectionnera le nom dans une liste déroulante. Ce récapitulatif donnera les informations suivantes : date de début et date de fin, nombre d’expositions, durée totale, durée moyenne, durée de la plus longue.

Avez vous s'ils vous plait un programme qui me permettra de faire ceci !

Rebonjour,

Le dernier problème a était résolu par l'un de vos collègues

Y a-t- il un moyen qui me permet d'ajouter une colonne durée sur le dernier programme que vous m'avez envoyé !! le contenu de cette colonne (heure de la sortie-heure d'entrée).

Ci-dessous un exemple pour celui par exemple qui a le badge N°2301.

Merci d'avance,