Private Sub Workbook_Open()
Dim texteCherche As String, message As String, celluleRecherche As Range, zoneRecherche As Range, lAdressePremCell As String
'initialiser le texte à chercher ("s24" si on est en semaine 22)
texteCherche = "s" & CStr(Application.WorksheetFunction.WeekNum(Now) + 2)
'initialiser la zone de recherche (colonne F)
Set zoneRecherche = ThisWorkbook.Sheets("Feuil1").Range("F:F")
message = "Penser à envoyer courrier pour annoncer le début des travaux :" & vbNewLine
'lancer la recherche
Set celluleRecherche = zoneRecherche.Find(texteCherche, , xlValues, xlWhole)
'si rien n'est trouver, quitter la procédure
If celluleRecherche Is Nothing Then Exit Sub
'sinon, mémoriser l'adresse de la première cellule trouvée
lAdressePremCell = celluleRecherche.Address
'boucler ...
Do
'traiter la cellule de recherche
'ajouter une ligne au message
message = message & vbNewLine & "chantier """ & celluleRecherche.Offset(0, -5) & ", " & _
celluleRecherche.Offset(0, -4) & ", " & celluleRecherche.Offset(0, -3) & """"
'rechercher la cellule suivante
Set celluleRecherche = zoneRecherche.FindNext(celluleRecherche)
'... tant que la cellule de recherche n'est pas revenu à la première cellule trouvée
Loop Until celluleRecherche.Address = lAdressePremCell
Set celluleRecherche = Nothing
MsgBox message
End Sub