@ Jesch
Oublie la version polymorphe précédente, c'était plus un exercice de style, mais les sites ont des écritures différentes et cela devient complexe de leur trouver des points communs.
Pour reprendre ta question sur l'intégration d'autres valeurs, tu as plusieurs méthodes à ta disposition
1- Power Query
je ne connais pas ta version d'excel ... si c'est possible, reprends la réponse de Jean-Eric https://forum.excel-pratique.com/viewtopic.php?p=731484#p731484
2- tu peux aussi un équivalent à PowerQuery que j'avais développé pour capter l'ensemble des tables du site, tu as ainsi toutes les informations pour peu qu'elles soient contenues dans des tables html
Sub Maj()
Dim URL$, obj As New DataObject
MsgBox "interro web ..."
On Error Resume Next
DoEvents
URL = [www]
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
If .Status = 200 Then
For i = 1 To UBound(Split(.responseText, "<table"))
txt = "<table" & Split(Split(.responseText, "<table")(i), "</table>")(0) & "</table>"
obj.SetText txt
obj.PutInClipboard
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Paste
ActiveSheet.Name = "Table #" & i
Next
End If
End With
MsgBox "Fin !"
End Sub
3- utiliser les DOM et décoder la page html par le biais de getelementbyid ... pour ici je n'ai pas vu la structuration suffisante des données de la page web pour l'utiliser
4- à défaut d'utiliser les DOM, et si tu veux interroger en rafale plusieurs pages en ciblant certaines données, tu peux utiliser un traitement via split de la réponse en texte du site web
Sub MajCotations()
Dim i%, k%, URL$, avant1$, avant2$, apres1$, apres2$, indice%
'On Error Resume Next
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
DoEvents
URL = Cells(i, "B").Value
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
If .Status = 200 Then
For k = 1 To 4
avant1 = Replace(Replace(Sheets("paramètres").Range("avant1").Offset(0, k).Value, "XXXXX", Cells(i, "A").Value), "'", "'")
apres1 = Sheets("paramètres").Range("apres1").Offset(0, k).Value
avant2 = Sheets("paramètres").Range("avant2").Offset(0, k).Value
apres2 = Sheets("paramètres").Range("apres2").Offset(0, k).Value
Cells(i, "B").Offset(0, k).Value = Val(mydata(.responseText, avant1, apres1, avant2, apres2))
Next
End If
End With
Next
End Sub
Function mydata(texte As String, debut1 As String, fin1 As String, debut2 As String, fin2 As String)
mydata = Split(Split(texte, debut1)(1), fin1)(0)
mydata = Split(Split(mydata, debut2)(1), fin2)(0)
End Function
ps : j'ai intégré dans l'interrogation la transformation de l'apostrophe !