Bonjour à tous,
Débutant en VBA, je viens faire appel à vos connaissances pour un problème que je rencontre avec une macro.
Je vous expose mon cas :
Je cherche à automatiser l'extraction d'une donnée depuis une liste d'url. J'ai donc créée un fichier excele avec trois feuillet (données / requête / url) et une macro qui fonctionne bien dans le sens ou lorsque je l’exécute, celle-ci effectue la requête, va chercher la bonne donnée et me l'inscrit sur le feuille données. Le soucis, c'est qu'avec plusieurs url, la macro me copie le résultat toujours dans la même cellule (A1) et donc au final je n'ai qu'un résultat.
Comment modifier ma macro pour que les résultats arrivent les uns à la suite des autres ?
Je pense qu'il faut placer un ("A" & DLig + 1) quelque part, mais c'est du bidouillage car je suis débutant en la matière.
Merci de votre.
Ci-après le code de la macro :
Débutant en VBA, je viens faire appel à vos connaissances pour un problème que je rencontre avec une macro.
Je vous expose mon cas :
Je cherche à automatiser l'extraction d'une donnée depuis une liste d'url. J'ai donc créée un fichier excele avec trois feuillet (données / requête / url) et une macro qui fonctionne bien dans le sens ou lorsque je l’exécute, celle-ci effectue la requête, va chercher la bonne donnée et me l'inscrit sur le feuille données. Le soucis, c'est qu'avec plusieurs url, la macro me copie le résultat toujours dans la même cellule (A1) et donc au final je n'ai qu'un résultat.
Comment modifier ma macro pour que les résultats arrivent les uns à la suite des autres ?
Je pense qu'il faut placer un ("A" & DLig + 1) quelque part, mais c'est du bidouillage car je suis débutant en la matière.
Merci de votre.
Ci-après le code de la macro :
HTML:
Public i As Integer
Sub lance_requête()
'Macro enregistré par MJ
Sheets("URL").Select
Range("A1").Select
derligne = ActiveSheet.Range("A65536").End(xlUp).Row
For i = 1 To derligne
req_web
Sheets("URL").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Next i
'efface la requête à la fin
Sheets("Requête").Select
Range("A1").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("Données").Select
End Sub
Sub req_web()
'Macro enregistré par MJ
'Dim i As Integer
Dim Chaine As String
'For i = 1 To 20
'ActiveWorkbook.Worksheets.Add
'Stop
'Chaine = "URL;" & Worksheets("URL").Cells(1, 1).Value
Chaine = ActiveCell.Value
Sheets("Requête").Select
With ActiveSheet.QueryTables.Add(Connection:="URL;" & Chaine, _
Destination:=Range("A1"))
.Name = "mairie-14237-01"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
compteur = 0
For ligne = 1 To 1000
If Left(Sheets("Requête").Cells(ligne, 1), 5) = "Faire" Then
compteur = compteur + 1
Sheets("Données").Cells(compteur, 1) = Sheets("Requête").Cells(ligne - 2, 1)
End If
Next
End Sub
Dernière édition:
