Question

免责声明-我过去经常写宏，但这是一种易腐的技能。 5年要付出代价。

基本概念是这样的：

我有一个模板工作簿，最多包含30个选项卡，所有选项卡都具有不确定的行和列（即，并非总是A7：J30-一个选项卡可能具有3列，接下来的34列。行也不确定。）
当前，有人正在将30个单独的CSV复制/粘贴到此模板工作簿中。
此模板化的工作簿被另一个程序读取以填充数据。每个模板工作表的第6行是其他程序在其中查找标头的位置（即，我可能会从A2：G1000复制CSV数据，但需要将其粘贴到模板目标工作簿的A7：G1005中）。
所有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

这使复制范围动态化，但是当我尝试选择范围时仍然出现对象错误。我从（Copy from one workbook and paste into another）获得了这种方法，但是它太简单了。另外，如果我想再添加20个标签，则必须再复制/粘贴此代码块20次，并每次更改变量。

我发现了这个问题（Copy multiple rows from multiple workbooks to one master workbook），但是Ron DeBruin的方法无法正常工作，因为我们必须将所有内容都移到第6行，而且我们不能指望CSV头正常工作。

我喜欢这里的最后一个答案（Dynamic range of data to paste into another sheet?），但似乎无法使它适用于其他工作簿中的单个工作簿目标。

我想使用一个数组或一组数组来声明我的工作表，但是我不知道如何一次遍历基于字符串的两个数组。我在想像这样的事情，但是我还没完成：

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

VBA阵列可将多个CSV复制到一个模板工作簿

1 个答案: