Importations multiples via le web

Sub Macro2()


Dim DLig As Long, Lig As Long, sht As Worksheet, sURL As String
  Dim NLig As Long
  ' Définir la feuille de données
  Set sht = Sheets("base")
  ' Récupérer la dernière ligne du tableau de données
  DLig = sht.Range("J" & Rows.Count).End(xlUp).Row
  ' Boucler sur tout le tableau
  Shell "RunDll32.exe InetCpl.cpl,ClearMyTracksByProcess 8"
  For Lig = 1 To 3
    ' récupérer l'url de la ligne
    sURL = sht.Range("I" & Lig)
    ' Sur la feuille 2
    With Sheets("Feuil2")
      ' TRouver la prochaine ligne vide
      NLig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
      ' Insérer la requête web
      With .QueryTables.Add(Connection:="URL;" & sURL, Destination:=.Range("$A$" & NLig))
        .Name = False
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingAll
        .WebTables = "11"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=True
      End With
    End With
  Next Lig



End Sub