Extraction données VBA

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 :

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

chris1234 a écrit :

compteur = 0

Bonjour,

Remplace la ligne ci-dessus par celle-ci et teste, sachant que c'est la variable "compteur" qui fixe la ligne d'arrivée des données, il faudra la trouver avant d'entrer dans la boucle "For" pour copier la requête :

compteur = Sheets("Données").Range("A" & Application.Rows.Count).End(xlUp).Row

Bonjour,

La formule marche parfaitement et je vous en remercie.

Néanmoins, quand je lance ma requête sur plusieurs URL, je n'arrive pas à obtenir plus de 6 résultats.

Une Idée ?