Sélectionner plusieurs données dans des pages Internet et les copier

Nonno 94

XLDnaute Occasionnel
Bonjour le forum,

je viens solliciter votre aide pour résoudre le problème suivant :

dans le fichier joint, le Code de la macro "Lire_Objectifs_Potentiels" me permet de sélectionner les données "Objectif" et "Potentiel" de Valeurs dans leur page Internet "Consensus" (voir les feuilles "AB Science et ABC Arbitrage) puis de les copier dans la feuille "Objectifs et Potentiels" du fichier.

Code:
Sub Lire_Objectifs_Potentiels()

    Dim IE As New InternetExplorer
    Dim IEDoc As HTMLDocument
    Dim HtmlTag As IHTMLElementCollection
    Dim Valeur1 As String, Valeur2 As String
    Dim Cel As Range, I As Integer

    Sheets("Objectifs et Potentiels").Select
        ActiveSheet.Unprotect

    For Each Cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        IE.Navigate Cel
        IE.Visible = True
        Do Until IE.readyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        Set IEDoc = IE.document

        Set HtmlTag = IEDoc.getElementsByTagName("td")

        Valeur1 = "N/A": Valeur2 = "N/A"
        For I = 0 To HtmlTag.Length - 1
            If HtmlTag.Item(I).innerText = "Potentiel" Then
                Valeur1 = HtmlTag.Item(I + 1).innerText         'Valeur 1 = Potentiel
              If HtmlTag.Item(I).innerText = "Potentiel" Then
                Valeur2 = HtmlTag.Item(I - 1).innerText         'Valeur 2 = Objectif
              End If
                Exit For
            End If
        Next I
        Cel.Offset(, 3) = Valeur1
        Cel.Offset(, 2) = Valeur2
    Next Cel

        IE.Visible = False

    Set HtmlTag = Nothing
    Set IEDoc = Nothing
    Set IE = Nothing


        IE.Visible = False
        
        Range("B1").Select
            ActiveSheet.Protect
        
                ActiveWorkbook.Save

End Sub

Afin de sélectionner les données "Cours" et "Potentiel" de ces valeurs dans leur page Internet "Synthèse " puis de les copier dans le feuille "Cours et Objectifs" du fichier, j'ai modifié le Code de la macro "Lire_Objectifs_Potentiels" et créé la macro "Lire_Cours_Potentiels".

Code:
Sub Lire_Cours_Potentiels()

    Dim IE As New InternetExplorer
    Dim IEDoc As HTMLDocument
    Dim HtmlTag As IHTMLElementCollection
    Dim Valeur1 As String, Valeur2 As String
    Dim Cel As Range, I As Integer

    Sheets("Cours et Potentiels").Select
        ActiveSheet.Unprotect

    For Each Cel In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        IE.Navigate Cel
        IE.Visible = True
        Do Until IE.readyState = READYSTATE_COMPLETE
            DoEvents
        Loop
        Set IEDoc = IE.document

        Set HtmlTag = IEDoc.getElementsByTagName("td")

        Valeur1 = "N/A": Valeur2 = "N/A"
        For I = 0 To HtmlTag.Length + 1
           
            If HtmlTag.Item(I).innerText = "Cours" Then
                Valeur1 = HtmlTag.Item(I + 1).innerText         'Valeur1 = HtmlTag.Item(I + 1).innerText

              If HtmlTag.Item(I).innerText = "Cours" Then
                Valeur2 = HtmlTag.Item(I + 23).innerText         'Valeur2 = HtmlTag.Item(I - 1).innerText '
              End If
                Exit For
            End If
        Next I
        Cel.Offset(, 3) = Valeur1
        Cel.Offset(, 2) = Valeur2
    Next Cel

        IE.Visible = False

    Set HtmlTag = Nothing
    Set IEDoc = Nothing
    Set IE = Nothing


        IE.Visible = False
        
        Range("B1").Select
            ActiveSheet.Protect
        
                ActiveWorkbook.Save

End Sub

Malheureusement, cette modification ne fonctionne pas et je ne copie que le Cours (ce que je souhaite) et seulement le nom "Potentiel" et pas sa valeur qui se trouve dans la cellule voisine sur la même ligne !
Pourriez-vous me dire ce qui "cloche" dans le code et quelle modification lui apporter ?

Est-il par ailleurs possible de sélectionner en même temps dans ces pages Internet "Synthèse" puis de copier dans la feuille "Cours et Potentiels" du fichier le Cours, l'Objectif et la Valeur ?

Je vous remercie par avance pour vos réponses et vous souhaite une bonne journée.

Cordialement.
Nonno 94.
 

Discussions similaires

Réponses
8
Affichages
627

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa