Copier url depuis cellule puis importer données VBA

BoogieDoogie -  
 BoogieDoogie -
Bonjour à tous,

Je cherche un code vba permettant que l'outil "obtenir des données à partir du web" récupère l'url dans une cellule, au lieu de saisir manuellement l'adresse.

Pour préciser, actuellement dans ma macro j'ai ce code :

Source = Web.Page(Web.Contents(""https://www.google.fr""))


Je cherche à faire en sorte que la macro copie l'url se trouvant par exemple en A1, au lieu de devoir saisir manuellement l'adresse web ; le reste du code permettant l'import des données est lui parfaitement en place.

Merci d'avance pour votre aide

2 réponses

  1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour,

    comme ceci:

    Range("A1").Value = ""https://www.google.fr""
    Source = Web.Page(Web.Contents(Range("A1").Value)
    


    voir si les double cotes sont necessaire!
    0
  2. BoogieDoogie
     
    Merci pour votre retour, j'ai beau essayer dans tous les sens, ça ne semble pas fonctionner...

    Je développe un peu mon propos.

    Sur un site web, je récupère des données statistiques sportives, je vous mets le code entier ci-dessous. La cellule contenant l'adresse web ne sera jamais la même selon le joueur dont je souhaite avoir les stats, c'est pour cela que je souhaite que la Macro récupère l'adresse mail dans une cellule, et exécute la requête selon l'adresse indiquée dans une cellule.

    Voici mon code entier, peut-être que ce sera plus parlant (l'adresse web se trouve donc dans le code). Celui-ci récupère le tableau sur le site, effectue un tri décroissant, ne récupère qu'une plage de données, la copie et colle les valeurs. Ensuite elle supprime la requête afin que, lorsque je lance une nouvelle recherche par la macro, celle-ci ne bloque pas à cause d'une requête déjà existante du même nom.

    Merci d'avance :)

    Sub Macro1()
    ActiveWorkbook.Queries.Add Name:="2019-20 Regular Season Table", Formula:= _
    "let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""https://www.basketball-reference.com/players/d/derozde01/gamelog/2020#pgl_basic::game_season""))," & Chr(13) & "" & Chr(10) & " Data7 = Source{7}[Data]," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = Table.TransformColumnTypes(Data7,{{""Rk"", Int64.Type}, {""G"", Int64.Type}, {""Date"", type date}, {""Age"", type text}, {""Tm"", type text}, {"""", type text}, {""Opp"", t" & _
    "ype text}, {""2"", type text}, {""GS"", type text}, {""MP"", type text}, {""FG"", type text}, {""FGA"", type text}, {""FG%"", type text}, {""3P"", type text}, {""3PA"", type text}, {""3P%"", type text}, {""FT"", type text}, {""FTA"", type text}, {""FT%"", type text}, {""ORB"", type text}, {""DRB"", type text}, {""TRB"", type text}, {""AST"", type text}, {""STL"", ty" & _
    "pe text}, {""BLK"", type text}, {""TOV"", type text}, {""PF"", type text}, {""PTS"", type text}, {""GmSc"", type text}, {""+/-"", type text}})," & Chr(13) & "" & Chr(10) & " #""Lignes triées"" = Table.Sort(#""Type modifié"",{{""G"", Order.Descending}})," & Chr(13) & "" & Chr(10) & " #""Plage de lignes conservée"" = Table.Range(#""Lignes triées"",0,10)" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Plage de lignes conservée"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
    "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""2019-20 Regular Season Table"";Extended Properties=""""" _
    , Destination:=Range("$A$1")).QueryTable
    .CommandType = xlCmdSql
    .CommandText = Array("SELECT * FROM [2019-20 Regular Season Table]")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .ListObject.DisplayName = "_2019_20_Regular_Season_Table"
    .Refresh BackgroundQuery:=False
    End With
    Range("_2019_20_Regular_Season_Table").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil1").Select
    Range("A10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("I55").Select
    Sheets(1).Select
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    ActiveWorkbook.Queries("2019-20 Regular Season Table").Delete
    Range("A1").Select
    End Sub
    0