Sub Lire_Blocs()
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim HtmlTag As IHTMLElementCollection
Dim Titre(2) As String, Valeur(2) As String
Dim Cel As Range, I As Integer
For Each Cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
IE.Navigate Cel
IE.Visible = False
Do Until IE.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Set IEDoc = IE.document
Set HtmlTag = IEDoc.getElementsByTagName("td")
Titre(0) = "Évolution semaine": Valeur(0) = "N/A"
Titre(1) = "Objectif de cours à 3 mois": Valeur(1) = "N/A"
Titre(2) = "Potentiel": Valeur(2) = "N/A"
For I = 0 To HtmlTag.Length - 1
If HtmlTag.Item(I).innerText = Titre(0) Then
Valeur(0) = HtmlTag.Item(I + 1).innerText
If HtmlTag.Item(I + 2).innerText = Titre(1) Then
Valeur(1) = HtmlTag.Item(I + 3).innerText
End If
If HtmlTag.Item(I + 4).innerText = Titre(2) Then
Valeur(2) = HtmlTag.Item(I + 5).innerText
End If
Exit For
End If
Next I
Cel.Offset(0, 2) = Titre(0): Cel.Offset(0, 3) = Valeur(0)
Cel.Offset(1, 2) = Titre(1): Cel.Offset(1, 3) = Valeur(1)
Cel.Offset(2, 2) = Titre(2): Cel.Offset(2, 3) = Valeur(2)
Next Cel
IE.Quit
Set HtmlTag = Nothing
Set IEDoc = Nothing
Set IE = Nothing
Range("B1").Select
End Sub