VBA 用于将多个 CSV 复制到一个模板工作簿的数组
VBA Array to copy multiple CSVs to one template workbook
免责声明 - 我以前经常写宏,但这是一种易腐烂的技能。 5年付出代价。
基本概念是这样的:
- 我有一个模板工作簿,最多有 30 个选项卡,所有选项卡都有不确定的行和列(即它并不总是 A7:J30 - 一个选项卡可能有 3 列,接下来的 34 列。行也是不确定。).
- 目前,有人正在 copy/pasting 30 个单独的 CSV 到这个模板工作簿中。
- 此模板化工作簿由另一个程序读取以填充数据。每个模板的第 6 行 sheet 是另一个程序查找 headers 的地方(即我可能会从 A2:G1000 复制 CSV 数据,但它需要粘贴到 A7:G1005模板目标工作簿)。
- 所有 CSV 都存储在同一目录中。我们可以 copy/paste 将模板工作簿放入该目录,运行 宏,然后完成。
到目前为止我做了什么:
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
这使复制范围动态化,但当我尝试 select 范围时,我仍然收到 object 错误。我从 (Copy from one workbook and paste into another) 得到这个方法,但它太简单了。另外,如果我想再添加 20 个选项卡,我必须 copy/paste 这段代码再阻塞 20 次并每次都更改变量。
我找到了这个 (Copy multiple rows from multiple workbooks to one master workbook),但是 Ron DeBruin 的方法行不通,因为我们必须将所有内容都移到第 6 行,而且我们不能指望 headers CSV 工作正常。
我喜欢这里的最后一个答案 (Dynamic range of data to paste into another sheet?),但我似乎无法使其适用于其他工作簿中的单个工作簿目标。
我想使用一个数组或一组数组来声明我的作品sheet,但我不知道如何同时遍历两个 string-based 的数组。我在想这样的事情,但我还没有完成:
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
免责声明 - 我以前经常写宏,但这是一种易腐烂的技能。 5年付出代价。
基本概念是这样的:
- 我有一个模板工作簿,最多有 30 个选项卡,所有选项卡都有不确定的行和列(即它并不总是 A7:J30 - 一个选项卡可能有 3 列,接下来的 34 列。行也是不确定。).
- 目前,有人正在 copy/pasting 30 个单独的 CSV 到这个模板工作簿中。
- 此模板化工作簿由另一个程序读取以填充数据。每个模板的第 6 行 sheet 是另一个程序查找 headers 的地方(即我可能会从 A2:G1000 复制 CSV 数据,但它需要粘贴到 A7:G1005模板目标工作簿)。
- 所有 CSV 都存储在同一目录中。我们可以 copy/paste 将模板工作簿放入该目录,运行 宏,然后完成。
到目前为止我做了什么:
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
这使复制范围动态化,但当我尝试 select 范围时,我仍然收到 object 错误。我从 (Copy from one workbook and paste into another) 得到这个方法,但它太简单了。另外,如果我想再添加 20 个选项卡,我必须 copy/paste 这段代码再阻塞 20 次并每次都更改变量。
我找到了这个 (Copy multiple rows from multiple workbooks to one master workbook),但是 Ron DeBruin 的方法行不通,因为我们必须将所有内容都移到第 6 行,而且我们不能指望 headers CSV 工作正常。
我喜欢这里的最后一个答案 (Dynamic range of data to paste into another sheet?),但我似乎无法使其适用于其他工作簿中的单个工作簿目标。
我想使用一个数组或一组数组来声明我的作品sheet,但我不知道如何同时遍历两个 string-based 的数组。我在想这样的事情,但我还没有完成:
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