Récuperer les liens "Aujourd'hui" sur le site ZETUF

Sub Bouton2_QuandClic()
'nécessite d'activer la référence Microsoft HTML Objects Library
'nécessite d'activer la référence Microsoft Internet Controls
 
Dim IE As New InternetExplorer
Dim x As Integer
Dim Doc As HTMLDocument
Dim Cel As Range

IE.Navigate "http://www.zeturf.fr/fr/programmes-et-pronostics"
Do Until IE.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
 
Set Doc = IE.Document
Columns(1).Clear
For x = 0 To Doc.Links.Length - 1
    If Left(Doc.Links(x), 60) = "http://www.zeturf.fr/fr/programmes-et-pronostics/reunion?id=" Then
        Cells(Rows.Count, 1).End(xlUp)(2) = Doc.Links(x)
    End If
Next
For Each Cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    ActiveSheet.Hyperlinks.Add Anchor:=Cel, Address:=Cel
Next Cel
Columns(1).AutoFit
IE.Quit
Set IE = Nothing
End Sub