Excel / VBA - просмотр списка URL (29 файлов .xls) для открытия и вставки данных в один лист

Question

У меня есть лист с 3 столбцами: URL - целевой лист - строка

URL-адреса автоматически указывают на загрузку файла .XLS (пример ниже):

http://www.eurexrepo.com/blob/157370/ccb5c831da64925cfc15aff4c5e4be85/data/euro_gjpbasket.xls

Я хотел бы иметь код VBA, который циклически перебирает строки (B2: B30), которые содержат 29 ссылок (см. Изображение), и копирует / вставляет данные в уникальный целевой лист (указанный ввторой столбец C2: C30) в предварительно определенном номере строки целевого листа (указан в 3-м столбце: D2: D30).

Список URL-адресов в ячейках

Вот код, который я пытаюсь использовать:

Sub Import_Baskets()

Dim Rows As Long, links As Variant, link As Variant
Rows = Sheets("Admin").Cells(Sheets("Admin").Rows.Count, "B").End(xlUp).Row
links = Sheets("Admin").Range("B1:B" & Rows)

    For Each link In links

        Dim wkbMyWorkbook As Workbook
        Dim wkbWebWorkbook As Workbook
        Dim wksWebWorkSheet As Worksheet

        Set wkbMyWorkbook = ActiveWorkbook

        ' *************************************************
        ' Open The Web Workbook
        ' *************************************************

        ' *************************************************
        ' Set the Web Workbook and Worksheet Variables
        ' *************************************************
        Set wkbWebWorkbook = ActiveWorkbook
        Set wksWebWorkSheet = ActiveSheet

        ' *************************************************
        ' Copy The Web Worksheet To My Workbook and Rename
        ' *************************************************
        wksWebWorkSheet.Copy After:=wkbMyWorkbook.Sheets(Sheets.Count)
        wkbMyWorkbook.Sheets(ActiveSheet.Name).Name = "GC"

        '.Range("$A$" + row_number)
        ' *************************************************
        ' Close the Web Workbook
        ' *************************************************
        wkbMyWorkbook.Activate
        wkbWebWorkbook.Close


    Next link

    'Next


End Sub

Любая помощь будет высоко оценена!:)

Answer 1

Это может работать для вашей ситуации.Хотя не проверял его, поэтому, пожалуйста, сохраните свою книгу перед попыткой.

Sub Import_Baskets()

    Dim lastRow As Long, link As String
    Dim targetSheet As Worksheet
    Dim webBook As Workbook
    Dim webSheet As Worksheet
    Dim shName As String
    Dim stRow As Long

    With ThisWorkbook.Worksheets("Admin")

        lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

        ' set your start and last row
        For row = 2 To lastRow

            link = Trim(CStr(.Range("B" & row).Value))
            shName = Trim(CStr(.Range("C" & row).Value))
            stRow = .Range("D" & row).Value

            ' open web wb
            Set webBook = Workbooks.Open(link)

            ' set web ws
            Set webSheet = webBook.Worksheets("enter desired sheet name")

            ' copy & paste
            On Error GoTo CreateSheet
            Set targetSheet = ThisWorkbook.Worksheets(shName)
            On Error GoTo 0
            webSheet.UsedRange.Copy destination:=targetSheet.Range("A" & stRow)

            ' close web wb        
            webBook.Close
            .Activate
        Next
    End With
    Exit Sub

' if sheet doesn't exist, insert it
CreateSheet:
    With ThisWorkbook
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = shName 
    End With
    Resume Next

End Sub