Search code examples
excelvbacopy-paste

Copy workbooks from the link addresses and paste it in to the range address

I am trying to write the code which will copy the content of specific sheet from another workbook based on the link address in my main workbook. Then, it should paste it to the sheet range in my main workbook that is also provided as range address. This has to be performed in the loop as I want to repeat it for 2 other workbooks stored under different links. All of those 3 workbooks stored under different links have the sheet named 'Data' which must be pasted in my main workbook.

Here is my main workbook that I have always opened when executing this code. In the sheet 'Start' I have the table that specifies 1) Link to the workbook from where data should be copied (col A), 2) Sheet Range Address where the data should be pasted in this main workbook (col B).

enter image description here

In my code, all would work except for the fact that the content of all 3 workbooks from provided links are pasted into 'Sheet1'!A1. I tried to F8 the code and it looks like the code does not loop properly in the column B.

Sub Copy_Paste()

Dim Ws_MainWS As Worksheet
Dim intFirstRow_Ws2 As Integer
Dim intLastCol_Ws2 As Integer
Dim ActiveWs As Variant
Dim Var_Ws2Link As Variant
Dim intListRow As Integer
Dim intListRow_Paste As Integer
Dim objTable As Excel.ListObject
Dim objRange As Excel.Range
Dim intLastRow_Ws1Tbl As Integer

Set Ws_MainWS = ThisWorkbook.Sheets("Start")
Set ActiveWs = ActiveWorkbook
Set objTable = Ws_MainWS.ListObjects("tblStart")

intLastRow_Ws1Tbl = Ws_MainWS.Cells(Rows.Count, 1).End(xlUp).row
intFirstRow_Ws2 = 1
Const ColumnStart As Integer = 1

On Error GoTo ErrorHandler

'Copy and Paste into provided sheet range address
    'Loop through Links to other workbooks
    For intListRow = 3 To intLastRow_Ws1Tbl
        Set Var_Ws2Link = Ws_MainWS.Cells(intListRow, 1)

            With objTable
                'Loop through pasting range addresses and paste
                For intListRow_Paste = 1 To .DataBodyRange.Rows.Count
                    Set objRange = Excel.Range(.DataBodyRange(intListRow_Paste, .ListColumns("Sheet Range address").Index).Value)
                         Workbooks.Open Var_Ws2Link, local:=True
                         intLastCol_Ws2 = Worksheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column
                        With Worksheets("Data")
                            .Range(.Cells(intFirstRow_Ws2, ColumnStart), .Cells(.Rows.Count, intLastCol_Ws2)).Copy
                            objRange.PasteSpecial xlPasteValues
                            Application.CutCopyMode = False
                            Set objRange = Nothing
                            ActiveWorkbook.Close
                        End With

                    Exit For

                Next intListRow_Paste
            End With

            Set objTable = Nothing

    Next intListRow

MsgBox "Done"


Exit Sub
ErrorHandler:

Set objTable = Nothing

End Sub

For looping through Pasting range addresses, I use object table. I would be grateful for any help on that!

Solution

  • If I have a two-column table like yours, this works for me.

    Split splits your address into two, the bit before the ! (sheet) and the bit after (cell address) so will crash if the address if not of this form.

    Sub x()

Dim r As Range, t As ListObject, wb As Workbook, v As Variant

Set t = Worksheets(1).ListObjects("Table1")

For Each r In t.ListColumns(1).DataBodyRange 'loop through column 1
    Set wb = Workbooks.Open(r.Value)         'open workbook
    v = Split(r.Offset(, 1).Value, "!")      'split cell in 2nd column
    wb.Worksheets(1).Range("A1").Copy ThisWorkbook.Worksheets(replace(v(0),"'","")).Range(v(1))        'paste
    wb.Close False
Next r

End Sub