VBA Array для копирования нескольких CSV в одну шаблонную книгу

Question

Отказ от ответственности - я много писал макросов, но это скоропортящийся навык. 5 лет - это плохо.

Основная концепция такова:

1. У меня есть шаблон книги с до 30 вкладками, у всех из которых есть неопределенные строки и столбцы (т.е. это не всегда A7: J30 - одна вкладка может иметь 3 столбца, следующие 34 столбца. Строки также являются неопределенными.).
2. В настоящее время кто-то копирует / вставляет 30 отдельных файлов CSV в эту шаблонную рабочую книгу.
3. Эта шаблонная рабочая книга читается другой программой для заполнения данных. Строка 6 каждого листа шаблона - это место, где другая программа ищет заголовки (то есть я мог бы скопировать данные CSV из A2: G1000, но для этого нужно было бы вставить в A7: G1005 целевой книги шаблона).
4. Все CSV хранятся в одном каталоге. Мы можем скопировать / вставить книгу шаблонов в этот каталог, запустить макрос и все готово.

Что я сделал до сих пор:

Sub V1BruteForceCopy()
'
'This code lives in ImportTemplate.XLSM, and is run from the same
'
Workbooks.Open (ThisWorkbook.Path & "\deposits.csv") 'Open deposits.CSV in same directory
Range("A2:G1000000").Copy                            'Very inflexible copy job - ugly.
Windows("ImportTemplate.xlsm").Activate              'hate to Activate, but can't get it to work without it.
Sheets("depositbatches").Range("A7").Select          'must call each Sheet in the code, instead of declare variable
ActiveSheet.Paste                                    'don't like Activate, but Sheets("depositbatches").Range("A7").Paste throws an error.
End Sub                                              'to add a new CSV and a new Sheet to copy to, I have to copy a whole new block of code and then overwrite Sheets("name") and Workbooks.Open(ThisWorkook.Path & "\name.csv") every time.

---

Другие вещи, которые я пробовал:

Sub rangecopy_001()

Dim ImpTemp As Workbook     'Reserved for ImportTemplate
Dim CSVdeposits As Workbook 'Reserved for deposits.CSV 
Dim shDeposits As Worksheet 'Deposits worksheet inside ImportTemplate
Dim lRow As Long            'variable for last row
Dim lCol As Long            'variable for last column
Dim test As Range           'variable for copy/paste range

Set ImpTemp = Workbooks.Open(ThisWorkbook.Path & "\ImportTemplate_CSV.xlsm") 'Open DWImportTemplate
Set CSVdeposits = Workbooks.Open(ThisWorkbook.Path & "\deposits.csv") 'Open deposits.CSV
Set shDeposits = ImpTemp.Sheets("depositbatches") 'Declare that shDeposits is a ImportTemplate sheet
With CSVdeposits 'copy out of deposits.CSV and paste into ImportTemplate deposits sheet

'find last row - makes this dynamic
lRow = Cells.Find(What:="*", _
                After:=Range("A1"), _
                LookAt:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

'find last column - makes this dynamic
lCol = Cells(1, Columns.Count).End(xlToLeft).Column

test = CSVdeposits.Sheet(1).Range("A2:" & Cells(lRow, lCol))  'error code 438 - Object doesn't support method
DW.shDeposits.Range("A7") = test                              


End With


End Sub

Это делает диапазон копирования динамическим, но я все еще получаю объектную ошибку, когда пытаюсь выбрать диапазон. Я получил этот метод от ( Скопируйте из одной рабочей книги и вставьте в другую ), но это слишком просто. Кроме того, если я хочу добавить еще 20 вкладок, я должен скопировать / вставить этот блок кода еще 20 раз и каждый раз менять переменные.

---

Я нашел это ( Скопируйте несколько строк из нескольких рабочих книг в одну основную рабочую книгу ), но дело Рона Дебрюина не сработает, потому что мы должны переместить все до 6-й строки, плюс мы не можем считать на заголовках CSV, работающих должным образом.

---

Мне нравится последний ответ здесь ( Динамический диапазон данных для вставки на другой лист? ), но я не могу заставить его работать для одной цели книги из других книг.

---

Я хочу использовать массив или набор массивов для объявления моих таблиц, но я не знаю, как перебирать два массива одновременно на основе строк. Я думаю что-то вроде этого, но я еще не закончил:

Sub ArrayCopyV1()
'
'This code lives in Template.XLSM and is run from the same. Copy this book to the directory you wish to copy from.
'
'
Dim ArraySheets As Variant   'an array with all Sheet names. Should have the same number of args as ArrayCSVs array.
Dim ArrayCSVs As Variant     'an array with all CSV names Should have the same number of args as ArraySheets array.
Dim template As Worksheet    'variable for template worksheet inside 
Template workbook
Dim CSV As Workbook          'variable for CSV workbook
Dim i As Integer             'variable i to be used in FOR loop counter
Dim lcol as Integer
Dim lrow as Integer

ArraySheets = Array("depositbatches", "otherSheet1", "OtherSheet2")
ArrayCSVs = Array("\deposits.csv", "other1.csv", "Other2.csv")

For i = LBound(ArraySheets) To UBound(ArraySheets)
Set CSV = Workbooks.Open(ThisWorkbook.Path & ArrayCSVs(i))
Set template = Workbooks.Open(ThisWorkbook.Path & ArraySheets(i))

    With CSV 'copy out of deposits.CSV and paste into DWImportTemplate deposits sheet

    'find last row - makes this dynamic
    lRow = Cells.Find(What:="*", _
                After:=Range("A1"), _
                LookAt:=xlPart, _
                LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False).Row

    'find last column - makes this dynamic
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column

    test = CSV.Sheet(1).Range("A2:" & Cells(lRow, lCol))
    template.Range("A7") = test


    End With
Next i
End Sub

Answer 1

Например:

Sub CopyAll()
    Dim rw As Range, wb As Workbook
    'read over your file<>sheet table
    For Each rw In ThisWorkbook.Sheets("Files").Range("A2:B30").Rows
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & rw.Cells(1).Value) '<< csv file name 
        With wb.Sheets(1).Range("A1").CurrentRegion
            'skip headers (relies on contiguous data)
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Copy _
                 ThisWorkbook.Sheets(rw.Cells(2).Value).Range("A7") '<< sheet name to paste into
        End With
        wb.Close False
    Next rw
End Sub