Continuer recherche

Bonjour,

Avec la macro (dans un USERFORM) ci dessus je recherche le nom d'un agent sur 8 feuilles.

Ma problématique est la suivante. La macro s'arrete sur le premier nom correspondant. Si ce n'est pas la même personne que je recherche je voudrais que la macro poursuive sa recherche.

Exemple si j'ai MARTIN Fabienne feuille 1 et MARTIN Murielle feuille 5. Ma macro s'arrete sur MARTIN Fabienne. mais je souhaiterai atteindre l'autre MARTIN

Merci de votre aide

Private Sub RECHERCHER_Click()

cherche = InputBox("valeur cherchée ?")

nbre = ThisWorkbook.Sheets.Count

For cptr = 7 To 17

If Sheets(cptr).Name <> ActiveSheet.Name Then

If Application.CountIf(Sheets(cptr).Cells, cherche) > 0 Then

Ln = Sheets(cptr).Range("A:A").Find(cherche, lookat:=xlWhole).Row 'lookat=whole veut dire recherche exacte

Sheets(cptr).Select

Range("A" & Ln).Select

Nom.Visible = True

Prenom.Visible = True

secteur.Visible = True

affectation.Visible = True

observation.Visible = True

T_depart.Visible = False

T_effectifs.Visible = False

T_embau.Visible = False

T_menu.Nom.Value = ActiveCell.Value

T_menu.Prenom.Value = ActiveCell.Offset(0, 1).Value

T_menu.secteur.Value = ActiveSheet.Name

T_menu.affectation.Value = "Agent affecté le " & ActiveCell.Offset(0, 4).Value

T_menu.observation.Value = ActiveCell.Offset(0, 28)

Exit Sub

End If

End If

Next

MsgBox "valeur cherchée, " & cherche & ", inconnue.", vbExclamation

End Sub

Bonjour

Sans fichier

A tester

Private Sub RECHERCHER_Click()
Dim Cel As Range, Depart As String

  cherche = InputBox("valeur cherchée ?")
  nbre = ThisWorkbook.Sheets.Count
  For cptr = 7 To 17

    If Sheets(cptr).Name <> ActiveSheet.Name Then
      If Application.CountIf(Sheets(cptr).Cells, cherche) > 0 Then
        Set Cel = Sheets(cptr).Range("A:A").Find(cherche, lookat:=xlWhole)  'lookat=whole veut dire recherche exacte
        Depart = Cel.Address
        Do
          'Sheets(cptr).Select
          'Range("A" & Ln).Select
          Nom.Visible = True
          Prenom.Visible = True
          secteur.Visible = True
          affectation.Visible = True
          observation.Visible = True
          T_depart.Visible = False
          T_effectifs.Visible = False
          T_embau.Visible = False
          T_menu.Nom.Value = Cel                      'ActiveCell.Value
          T_menu.Prenom.Value = Cel.Offset(0, 1)      'ActiveCell.Offset(0, 1).Value
          T_menu.secteur.Value = Sheets(cptr).Name    'ActiveSheet.Name
          T_menu.affectation.Value = "Agent affecté le " & Cel.Offset(0, 4).Value  'ActiveCell.Offset(0, 4).Value
          T_menu.observation.Value = Cel.Offset(0, 28)  'ActiveCell.Offset(0, 28)
          If MsgBox("On Continue la recherche ? ", vbQuestion + vbYesNo, "Cherche encore ?") <> vbYes Then Exit Sub
          Set Cel = Sheets(cptr).Range("A:A").FindNext(Cel)
        Loop While Depart <> Cel.Address
      End If
    End If
  Next
  MsgBox "valeur cherchée, " & cherche & ", inconnue.", vbExclamation

End Sub

Si pas ça

Bonjour BANZAI64

JE me doutais que j'aurai ce retour.(pas de fichier joint)

Mon fichier est très volumineux.

En tout cas ca marche très bien

je te remercie

tseoy