Import multiple page web chacune dans une nouvelle feuille

Sub test1()
Dim nouvsh As Worksheet

Sheets("Urls").Select
    ActiveCell.Select
  
Dim I As Long, A As String
' declaring variables
With ActiveSheet
    I = 2
    Do
        A = .Cells(I, 1).Value
        If A <> "" Then
            Set nouvsh = Worksheets.Add(, Worksheets(Worksheets.Count))
            nouvsh.Name = "URL" & CStr(I)
            'lrc = .Cells(Rows.Count, "A").End(xlUp).Row 'last row in C column
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;" & A, Destination:=nouvsh.[A1])
                .Name = I
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertEntireRows
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlAllTables
                .WebFormatting = xlWebFormattingNone
                '.WebTables = "1,2"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
        End If
        I = I + 1
    Loop Until A = ""
End With
End Sub