Copier url depuis cellule puis importer données VBA Fermé

Question

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

cs_Le Pivert · Answer

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!

BoogieDoogie · Answer

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").SelectEnd Sub

Copier url depuis cellule puis importer données VBA

2 réponses

Discussions similaires