MACRO RECHERCHER

Sub Recherche()
Application.ScreenUpdating = False    [COLOR=#008000] 'Bloque la mise à jour de l'écran, permet d’accélérer le traitement de la macro[/COLOR]
[COLOR=#008000]'Définition des variables[/COLOR]
Dim motcle As Variant
Dim fin As Integer
Dim c1 As Variant, c2 As Variant, c3 As Variant
Dim first As Integer, second As Integer, third As Integer
    With Sheets(1)   [COLOR=#008000]'se positionne sur la 1ère feuille du classeur on aurait aussi pu écrire Sheets("Feuille de recherche")[/COLOR]
motcle = .Range("B2").Value      [COLOR=#008000]'définit que le motcle se trouve en cellule B2[/COLOR]
[COLOR=#008000]' ___________Test si un mot clé a été donné[/COLOR]
If motcle = "" Then
[COLOR=#008000]' Si aucun mot clé, on alerte et on arrete la procédure[/COLOR]
       MsgBox ("Aucun mot clé n'a été donné")
        End
        End If
    End With
  [COLOR=#008000]'_____________________________________________________________[/COLOR]
  
    With Sheets(2).Range("A2:A" & Range("A2").End(xlDown).Row)   [COLOR=#008000]'se positionne sur la colonne A de la 2ème feuille du classeur et va de A2 jusqu'à la dernière ligne où il y a une cellule de remplie, attention avec cette méthode il ne faut pas laisser de ligne vide entre les personnes sinon la sélection s'arrêtera au dernier nom avant la ligne vide[/COLOR]
   Set c1 = .Find(motcle, LookIn:=xlValues) [COLOR=#008000] [COLOR=#008000]' recherche du mot clé dans la plage selectionnée ci-dessus[/COLOR]
        If c1 Is Nothing Then        [COLOR=#008000]' si mot clé non trouvé alors[/COLOR]
       MsgBox ("Personne non présente en 2011!") [COLOR=#008000]' fait apparaître un message à l'écran[/COLOR]
       Range("B3:F3").ClearContents        [COLOR=#008000]' vide les cellules de B3 à F3 sur la 1ère feuille du classeur si elles étaient remplies par une recherche précédente[/COLOR]
       ElseIf Not c1 Is Nothing Then      [COLOR=#008000]  ' si le mot clé est trouvé[/COLOR]
       first = c1.Row                 [COLOR=#008000]'définit le mot first comme étant la ligne complète où se situe le mot clé[/COLOR]
       End If
    End With
    If Not c1 Is Nothing Then                    [COLOR=#008000]' si le mot clé a été trouvé alors[/COLOR]
       Sheets(2).Range("A" & first & ":F" & first).Copy     [COLOR=#008000]' selection de la plage A à F de la ligne où le mot clé a été trouvé et copie[/COLOR]
        Sheets(1).Range("B3").Select          [COLOR=#008000]'Selection de la cellule B3 de la 1ère feuille du classeur[/COLOR]
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False                    [COLOR=#008000]' collage des valeurs copiées[/COLOR]
    End If
    With Sheets(3).Range("A2:A" & Range("A2").End(xlDown).Row) [COLOR=#008000] 'on recommence la même procédure avec la feuille 3 du classeur[/COLOR]
        Set c2 = .Find(motcle, LookIn:=xlValues)
         If c2 Is Nothing Then
            MsgBox ("Personne non présente en 2012!")
            Range("B4:F4").ClearContents
        ElseIf Not c2 Is Nothing Then
        second = c2.Row
        End If
    End With
    If Not c2 Is Nothing Then
        Sheets(3).Range("A" & second & ":F" & second).Copy
        Sheets(1).Range("B4").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
    With Sheets(4).Range("A2:A" & Range("A2").End(xlDown).Row)     [COLOR=#008000]' on recommence encore la même procédure avec la feuille 4 du classeur[/COLOR]
         Set c3 = .Find(motcle, LookIn:=xlValues)
         If c3 Is Nothing Then
            MsgBox ("Personne non présente en 2013!")
            Range("B5:F5").ClearContents
        ElseIf Not c2 Is Nothing Then
        third = c3.Row
        End If
    End With
    If Not c3 Is Nothing Then
        Sheets(4).Range("A" & second & ":F" & second).Copy
        Sheets(1).Range("B5").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
    
Sheets(1).Range("B2").Select              [COLOR=#008000]' on se positionne sur la cellule B2 de la 1ère feuille du classeur[/COLOR]
Application.ScreenUpdating = True      [COLOR=#008000]' on réactive la mise à jour de l'écran[/COLOR]

End Sub

Function CellSuiv(adresse As Range)
Application.Volatile
  CellSuiv = Application.Caller.Parent.Next.Range(adresse.Address)
End Function

Private Sub Workbook_Open()
Dim Jour As Long

  Jour = Day(Date) + 1
  With Sheets("Synthese")
    If .Range("C" & Jour) <> Date Then
      .Range("C" & Jour) = Date
      .Range("D" & Jour) = Sheets("Feuil2").Range("B4").Value
    End If
  End With
End Sub