VBA阵列可将多个CSV复制到一个模板工作簿 [英] VBA Array to copy multiple CSVs to one template workbook

问题描述

免责声明-我过去经常写宏，但这是一种易腐的技能。

Disclaimer - I used to write macros a lot, but it's a perishable skill. 5 years takes it toll.

基本概念是这样的：

1. I拥有一个模板工作簿，该工作簿最多包含30个选项卡，所有选项卡都具有不确定的行和列（即，并非总是A7：J30-一个选项卡可能具有3列，接下来的34列。行也是不确定的。）


2. 当前，有人正在将30个单独的CSV复制/粘贴到此模板工作簿中。


3. 此模板工作簿已由另一个程序读取以填充数据。每个模板工作表的第6行是其他程序在其中查找标头的位置（即，我可能会从A2：G1000复制CSV数据，但需要粘贴到模板目标工作簿的A7：G1005中）。


4. 所有CSV存储在同一目录中。我们可以将模板工作簿复制/粘贴到该目录中，运行宏，然后完成。

1. I have a template workbook, with up to 30 tabs, that all have indeterminate rows and columns (i.e. It's not always A7:J30 - one tab might have 3 columns, the next 34 columns. Rows are also indeterminate.).
2. Currently, someone is copy/pasting 30 separate CSVs into this one templated workbook.
3. This templated workbook is read by another program to populate data. Row 6 of each template sheet is where the other program looks for headers (i.e. I might copy a CSV's data from A2:G1000, but it would need to paste in A7:G1005 of the template target workbook).
4. All of the CSVs are stored in the same directory. We can copy/paste a Template workbook into that directory, run a macro, and be done.

到目前为止，我已经完成了什么：

What I've done so far:

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.

---

我尝试过的其他方法：

---

Other things I've tried:

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次，并每次更改变量。

This makes the copy range dynamic, but I'm still getting an object error when I try to select the range. I got this method from (Copy from one workbook and paste into another) but it's too simple. Plus, if I want to add another 20 tabs, I have to copy/paste this code block another 20 times and change the variables each time.

我找到了这个（复制多个行从多个工作簿到一个主工作簿），但是Ron DeBruin的东西行不通，因为我们必须将所有内容都移到第6行，而且我们不能指望CSV头正常工作。

I found this (Copy multiple rows from multiple workbooks to one master workbook), but Ron DeBruin's thing won't work because we have to move everything down to Row 6, plus we can't count on the headers of the CSVs working properly.

我喜欢这里的最后一个答案（），但我似乎无法使其适用于其他工作簿中的单个工作簿目标。

I like the last answer here (Dynamic range of data to paste into another sheet?) but I can't seem to make it work for a single workbook target from other workbooks.

我想使用一个数组或一组数组来声明我的工作表，但是我不知道如何一次迭代两个数组，即s基于tring的。我在想这样的事情，但我还没做完：

I want to use an array, or set of arrays to declare my worksheets, but I don't know how to iterate over two arrays at one time that are string-based. I'm thinking something like this, but I'm not done:

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

推荐答案

例如：

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

这篇关于VBA阵列可将多个CSV复制到一个模板工作簿的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！