Скопируйте рабочие книги с адресов ссылок и вставьте их в адрес диапазона

Question

Я пытаюсь написать код, который будет копировать содержимое листа c из другой рабочей книги на основе адреса ссылки в моей основной рабочей книге. Затем он должен вставить его в диапазон листа в моей основной книге, который также указан в качестве адреса диапазона. Это должно быть выполнено в l oop, так как я хочу повторить это для 2 других книг, хранящихся по разным ссылкам. Все эти 3 книги, хранящиеся по разным ссылкам, имеют лист «Данные», который необходимо вставить в мою основную книгу.

Вот моя основная книга, которую я всегда открывал при выполнении этого кода. В листе «Пуск» у меня есть таблица, в которой указано: 1) Ссылка на рабочую книгу, из которой следует копировать данные (столбец A), 2) Адресный диапазон листа, куда данные должны быть вставлены в эту основную рабочую книгу (столбец B).

В моем коде все будет работать, за исключением того факта, что содержимое всех 3 рабочих книг по предоставленным ссылкам будет вставлено в «Лист1»! A1. Я попытался ввести код F8, и похоже, что код не корректно отображает l oop в столбце 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

Для зацикливания адресов диапазона вставки я использую таблицу объектов. Буду признателен за любую помощь в этом!

Answer 1

Если у меня есть таблица из двух столбцов, как у вас, это работает для меня.

Split разбивает ваш адрес на два, бит перед! (лист) и бит после (адрес ячейки), так что cra sh, если адрес, если не этой формы.

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