Sub Макрос1()

    Dim CurRow As Long
    For Each link In Worksheets("Лист1").Range("A:A").Cells
     With Worksheets("Лист2")
        CurRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
    End With
    With Worksheets("Лист2").QueryTables.Add(Connection:= _
        "URL;" & link.Value, Destination:=Worksheets("Лист2").Range("$A$" & CurRow _
        ))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        '.WebSelectionType = xlAllTables
        .WebFormatting = xlNone
        '.WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = False
        .WebSingleBlockTextImport = True
        .WebDisableDateRecognition = True
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
Next
End Sub

Sub GetNames()
 
    Application.Run "Êíèãà1!Ìàêðîñ2"
    *пока  (не пустая ячейка в столбце А) делать:
    k=k+1
    i = НомерПоследнейЗанятойЯчейки в (ТекущаяКнига.Лист2.СтолбецА) + 1*
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;*ТекущаяКнига.Лист1.А[k]*", Destination:=*ТекущаяКнига.Лист2.А[i]*
        .CommandType = 0
        .Name = *ПолучитьИмяФайла(A[k])*//не знаю, нужно ли это вообще или достаточно полного url, который мы уже указали
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        *  .WebTables = "2"* //тут будет номер таблицы на странице вместо .WebSelectionType = xlAllTables

        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

Sub GetNames()

    Application.Run "Êíèãà1!Ìàêðîñ2"
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://names.mongabay.com/most_common_surnames.htm", Destination:=Range( _
        "$A$1"))
        .CommandType = 0
        .Name = "most_common_surnames"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub