Sub Lire_Objectifs_et_Potentiels()
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim HtmlTag As IHTMLElementCollection
Dim Valeur As String, Cel As Range, I As Integer
Sheets("Valeurs").Select
ActiveSheet.Unprotect
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")
Valeur = "N/A"
For I = 0 To HtmlTag.Length - 1
If HtmlTag.Item(I).innerText = "Objectif de cours à 3 mois" Then
Valeur = HtmlTag.Item(I + 1, I + 3).innerText
Exit For
End If
Next I
Cel.Offset(1, 3) = Valeur
For I = 0 To HtmlTag.Length - 1
If HtmlTag.Item(I).innerText = "Potentiel" Then
Valeur = HtmlTag.Item(I + 1).innerText
Exit For
End If
Next I
Cel.Offset(2, 3) = Valeur
Next Cel
Set HtmlTag = Nothing
Set IEDoc = Nothing
Set IE = Nothing
Range("B1").Select
ActiveSheet.Protect
ActiveWorkbook.Save
End Sub