Bonjour à tous,

Il y a une quinzaine d'années j'ai fait une demande un peu similaire.
J'ai retrouver les discussions et les anciens classeurs mais il semble que certaines valeurs dans les codes ne soient plus correct, j'ai notamment une erreur avec webbrowser.

Voila ce que je souhaite faire.
Dans le classeur joint vous verrez en page 1 une liste de lien.
Liste réduite a 5 pour les tests mais en finalité il devrait y en avoir des dizaines
Le code doit cliquer sur chaque lien pour ouvrir une page web
Sur cette page il n'y a qu'un tableau
Je souhaite que les données de chaque tableau soit accumuler en page 2 du classeur.

Merci d'avance pour votre aide.

Bonsoir Icedarts, le Forum,

Tu trouveras en pièce-jointe sans doute une façon de faire :

DANS UN MODULE DE CODE STANDARD (ex : Module1)

Option Explicit

Sub RecupDatas()
' myDearFriend! - www.mdf-xlpages.com
' Mars 2023

' Nécessite une référence à "Microsoft HTML Object Library"
Dim vTabLiens As Variant
Dim iDoc As New MSHTML.HTMLDocument
Dim TabDoc As HTMLTable
Dim Lnk As Long, NbLignTab As Long, Lmax As Long, L As Long
Dim NbColTab As Byte, C As Byte
    'Liste des liens
    vTabLiens = Sheets("Liens").Cells(1, 1).CurrentRegion.Value
    'Pour chaque lien
    For Lnk = 1 To UBound(vTabLiens, 1)
        'Récup table datas
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", vTabLiens(Lnk, 1), False
            .send
            iDoc.body.innerHTML = .responseText
        End With
        Set TabDoc = iDoc.getElementById("tableSort")
        
        NbLignTab = TabDoc.Rows.Length - 1
        NbColTab = TabDoc.Rows(0).Cells.Length - 1
        
        'Complétude du tableau
        With Sheets("Données")
            For L = 1 To NbLignTab
                For C = 0 To NbColTab
                    .Cells(Lmax + L + 1, C + 1).Value = TabDoc.Rows(L).Cells(C).innerText
                Next C
            Next L
        End With
        Lmax = Lmax + NbLignTab
    Next Lnk
    
    MsgBox "Récup terminée !"
    
    Set TabDoc = Nothing
    Set iDoc = Nothing
End Sub

Nb : tu n'as pas besoin de faire usage d'un webBrowser pour le fonctionnement de ce code.

En espérant t'avoir aidé.

Bien cordialement,

Bonjour,

Merci ça répond exactement à mes attentes.
Juste une chose car je n'avais pas pensé aux doublons d'un lien à l'autre.

J'ai donc ajouter une colonne en page 1 avec une info pour chaque lien.
Est-il possible de rajouter cette info sur chaque ligne dans la page 2

Le lien 1 on récupère X lignes on ajoute l'info sur ces X lignes

On passe au lien 2 on ajoute l'info du lien 2 sur les X nouvelles lignes etc etc.

Exemple en pièce jointe ça sera plus explicite ^^

Merci d'avance.

Bonsoir Icedarts, le Forum,

En modifiant une partie du code précèdent comme suit (en rouge), ça devrait suffire pour répondre à cette nouvelle demande :

       'Complétude du tableau
        With Sheets("Données")
            For L = 1 To NbLignTab
                For C = 0 To NbColTab
                    With .Cells(Lmax + L + 1, C + 1)
                        .Value = TabDoc.Rows(L).Cells(C).innerText
                        If C = NbColTab Then
                            .Offset(0, 1).Value = vTabLiens(Lnk, 2)
                        End If
                    End With
                Next C
            Next L
        End With

En pièce jointe, le code en action.

Bien cordialement,

Merci beaucoup c'est parfait.

Citation :

Bonjour,

J'essaie de poster ici car je n'arrive pas a créer de sujet.
Il y a un problème avec le forum?