Importation d'une page web avec somme en fonction de la date

Bonjour,

J'ai une erreur d'exécution ' 1004'

Vu, curieux !

Je vais finaliser demain matin avec le TCD et je regarderai ce point.

Avec le TCD

Pour la suppression des images importées du web, mon but est d'alléger le document car ces images sont inutiles. Dès lors que l'image est identifiée, c'est curieux qu'elle ne puisse pas être supprimée par delete. Comme ce n'est pas fondamental, j'ai ajouté un on error resume next.

Sub Maj()
Dim url$, obj As New DataObject, f As Worksheet, u As Worksheet, s As Worksheet, img As Object
Set f = Sheets("Résultat")
Set u = Sheets("URL")
Set s = Sheets("Synthèse")

    f.Cells(1, 2).CurrentRegion.Offset(1, 0).ClearContents
    f.Select
    DoEvents
    For i = 2 To u.Cells(Rows.Count, 1).End(xlUp).Row
        url = u.Cells(i, 1).Value
        f.Cells(Rows.Count, 2).End(xlUp).Offset(1, -1).Select
        debut = Selection.Row
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", url, False
            .Send
            If .Status = 200 Then
                For j = 1 To UBound(Split(.responseText, "<table"))
                    extrait = Split(Split(.responseText, "<table")(j), "</table>")(0)
                    If InStr(extrait, "Date de l'achat") > 0 Then
                        txt = "<table" & extrait & "</table>"
                        obj.SetText txt
                        obj.PutInClipboard
                        f.Paste
                        Application.Wait Now + TimeValue("0:00:02")
                        f.Rows(debut).Delete
                        fin = f.Cells(Rows.Count, 2).End(xlUp).Row
                        f.Range(f.Cells(debut, 1), f.Cells(fin, 1)) = "'" & Split(url, "=")(1)
                        f.Range(f.Cells(debut, 6), f.Cells(fin, 6)).FormulaR1C1 = "=INT(SUBSTITUTE(SUBSTITUTE(RC[-1],"" Paris"",""""),""."","""")*1)"
                    End If
                Next
            End If
        End With
    Next
    On Error Resume Next
    For Each img In f.Pictures
        img.Delete
    Next
    On Error GoTo 0
    Columns("F:F").Select
    Selection.NumberFormat = "m/d/yyyy"
    fin = f.Cells(Rows.Count, 2).End(xlUp).Row

    s.Select
    s.PivotTables(1).ChangePivotCache _
        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        ActiveWorkbook.Path & "\[ebay-charger-les-tables-html.xlsm]Résultat!R1C1:R" & fin & "C6" _
        , Version:=xlPivotTableVersion15)
    s.PivotTables(1).PivotCache.Refresh

MsgBox "Fin !"
End Sub

Merci

il me met erreur d’exécution

Si tu as renommé le fichier, change le nom dans la macro.

Ou change en

    s.PivotTables("Tableau croisé dynamique1").ChangePivotCache _
        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        ActiveWorkbook.Path & "\[" & ThisWorkbook.Name & "]Résultat!R1C1:R" & fin & "C6" _
        , Version:=xlPivotTableVersion15)

Merci

Bonjour,

Je viens de mettre de nouvel url

et il m'affiche ca :

Ci joint le fichier avec les url qui bloque

Pourquoi as-tu fusionné des cellules de la ligne 19 ?

Je ne l'ai pas fusionné, je viens de la defusionné et quan je lance la macro elle se retrouve fusionné

ah, ok, c'est donc lié à ebay ... ben il suffira d'ajouter l'instruction de défusion.

MAIS ... le problème est plus complexe car dans ces nouvelles urls, les données ne se trouvent pas aux mêmes endroits que les données de test !! J'avais déjà repéré qu'il pouvait y avoir un nombre de tableaux différent d'un site à l'autre et qu'il fallait faire une recherche. Mais pour traiter un site polymorphe, que ce soit avec PowerQ ou en macro, dans la mesure où on ne connait pas ls différents cas de figure, c'est mission impossible.

C'est deja super ce que tu as fait.

merci