Loop through list of URLs (29 .xls files) to open and paste data into 1 single sheet

Question

I have a sheet with 3 columns: URL - Target Sheet - Row

The URLs direct you to a .XLS file download automatically (example below):

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

What I would like to do is to have a VBA code that loops through the rows (B2:B30) that contain the 29 links (please see image) and copy/pastes the data into a unique target sheet (specified in the second column C2:C30) in a predefined row number of the target sheet (specified in 3rd column: D2:D30).

List of URLs in cells

This is the code that I am trying to use:

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

Any help will be much appreciated! :)

Answer 1

This could work for your situation. Haven't tested it though so please save your workbook before trying.

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