Cfrgtkky

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! :)

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