lien hypertexte date

Sub DateFinder()
Dim DateOfToday As Date
Dim Plage As Range, Cell As Range

DateOfToday = Date

With Sheets('Calendrier')
Set Plage = .Range(.Range('A2'), .Range('A65536').End(xlUp))
End With

    For Each Cell In Plage
    If IsDate(Cell) Then
        If CDate(Cell) = DateOfToday Then
            Worksheets('Calendrier').Activate
            ActiveWindow.ScrollRow = Cell.Row
            Cell.Select
            Exit For
        End If
    End If
    Next

End Sub

Cliquez pour agrandir...