Bonjour le Forum,😕
j'essaie sans succès de modifier le code suivant communiqué par Myta qui permet d'importer et copier 4 données d'une même ligne pour créer les 2 nouveaux codes suivants qui permettront d'importer :
- pour le premier 8 données situées sur une même ligne
- pour le second un tableau comportant environ 20 lignes de 8 données.
Pour expliciter ma demande, je joins un fichier exemple comprenant les 2 pages-sources Internet et les macros suivantes dont je ne parviens pas à modifier les codes :
- 'Lire_Ligne_SRD_Myta' qui "déraille" si étendu à l'import de plus de 3 valeurs
- et 'Lire_Tableau_SRD_Myta' qui "déraille" après l'import de la 1 ère valeur.
Le code de départ communiqué par Myta et qui permet d'importer 4 données situées sur une même ligne est le suivant :
J'avoue être découragé et m'en remets donc à vous pour me sortir de ce mauvais pas.
En vous remerciant par avance pour vos réponses.
Cordialement.
Nonno 94.
j'essaie sans succès de modifier le code suivant communiqué par Myta qui permet d'importer et copier 4 données d'une même ligne pour créer les 2 nouveaux codes suivants qui permettront d'importer :
- pour le premier 8 données situées sur une même ligne
- pour le second un tableau comportant environ 20 lignes de 8 données.
Pour expliciter ma demande, je joins un fichier exemple comprenant les 2 pages-sources Internet et les macros suivantes dont je ne parviens pas à modifier les codes :
- 'Lire_Ligne_SRD_Myta' qui "déraille" si étendu à l'import de plus de 3 valeurs
- et 'Lire_Tableau_SRD_Myta' qui "déraille" après l'import de la 1 ère valeur.
Le code de départ communiqué par Myta et qui permet d'importer 4 données situées sur une même ligne est le suivant :
Code:
Sub Lire_Ligne_SRD_Myta()
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
Sheets("Ligne SRD").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")
Titre(0) = "ACCOR": Valeur(0) = "N/A"
For I = 0 To HtmlTag.Length - 1
If HtmlTag.Item(I).innerText = Titre(0) Then
Valeur(0) = HtmlTag.Item(I + 1).innerText
Valeur(1) = HtmlTag.Item(I + 2).innerText
Valeur(2) = HtmlTag.Item(I + 3).innerText
Exit For
End If
Next I
Cel.Offset(0, 1) = Titre(0): Cel.Offset(0, 2) = Valeur(0): Cel.Offset(0, 3) = Valeur(1): Cel.Offset(0, 4) = Valeur(2)
Next Cel
IE.Visible = False
IE.Quit
Set HtmlTag = Nothing
Set IEDoc = Nothing
Set IE = Nothing
Range("B1").Select
ActiveSheet.Protect
ActiveWorkbook.Save
End Sub
J'avoue être découragé et m'en remets donc à vous pour me sortir de ce mauvais pas.
En vous remerciant par avance pour vos réponses.
Cordialement.
Nonno 94.