Excel VBA – 循环播放文件夹中的文件，复制范围，粘贴在此工作簿中

我有500个Excel文件的数据。 我会将所有这些数据合并到一个文件中。

任务列表来实现这一点：

1. 我想循环一个文件夹中的所有文件
2. 打开文件，
3. 复制这个范围“B3：I102”
4. 将其粘贴到活动工作簿的第一个工作表中
5. 重复，但粘贴下面的新数据

我已经完成了任务1-4，但是我需要帮助完成任务5，最后一点 – 在现有数据下粘贴数据并使其dynamic化。 我在代码中用'####'突出显示了这一点。

这是我从其他人的问题放在一起的代码:)

任何build议如何做到这一点？

Sub LoopThroughFiles() Dim MyObj As Object, MySource As Object, file As Variant Dim wbThis As Workbook 'workbook where the data is to be pasted, aka Master file Dim wbTarget As Workbook 'workbook from where the data is to be copied from, aka Overnights file Dim LastRow As Long Dim sht1 As Worksheet Dim sht2 As Worksheet 'set to the current active workbook (the source book, the Master!) Set wbThis = ActiveWorkbook Set sht1 = wbThis.Sheets("Sheet1") Folder = "\\dne\ldc\research-dept\3 CEEMEA\15. EMB\Turkey\TLC Overnight & Weekly Reports\weekly (majeed)\" Fname = Dir(Folder) While (Fname <> "") Set wbTarget = Workbooks.Open(Filename:=Folder & Fname) wbTarget.Activate Range("b3:i102").Copy wbThis.Activate '################################ 'NEED HELP HERE. I GET A ERROR HERE. NEEDS TO BE MORE DYNAMIC. sht1.Range("b1:i100").PasteSpecial Fname = Dir 'close the overnight's file wbTarget.Close Wend End Sub 

Answer 1

我认为使用变种比复制方法有用。

 Sub LoopThroughFiles() Dim MyObj As Object, MySource As Object file As Variant Dim wbThis As Workbook 'workbook where the data is to be pasted, aka Master file Dim wbTarget As Workbook 'workbook from where the data is to be copied from, aka Overnights file Dim LastRow As Long Dim sht1 As Worksheet Dim sht2 As Worksheet Dim vDB As Variant 'set to the current active workbook (the source book, the Master!) Set wbThis = ActiveWorkbook Set sht1 = wbThis.Sheets("Sheet1") Folder = "\\dne\ldc\research-dept\3 CEEMEA\15. EMB\Turkey\TLC Overnight & Weekly Reports\weekly (majeed)\" Fname = Dir(Folder) While (Fname <> "") Set wbTarget = Workbooks.Open(Filename:=Folder & Fname) vDB = wbTarget.Sheets(1).Range("b3:i102") '################################ 'NEED HELP HERE. I GET A ERROR HERE. NEEDS TO BE MORE DYNAMIC. sht1.Range("b" & Rows.Count).End(xlUp)(2).Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB Fname = Dir 'close the overnight's file wbTarget.Close Wend End Sub 

Answer 2

我看到你已经为此添加了一个长variables，所以在粘贴之前在最后一行进行查找。 另外，如果数据量不同，请粘贴在一个单元中。

我改变你的脚本如下。

 Sub LoopThroughFiles() Dim MyObj As Object, MySource As Object, file As Variant Dim wbThis As Workbook 'workbook where the data is to be pasted, aka Master file Dim wbTarget As Workbook 'workbook from where the data is to be copied from, aka Overnights file Dim LastRow As Long Dim sht1 As Worksheet Dim sht2 As Worksheet 'set to the current active workbook (the source book, the Master!) Set wbThis = ActiveWorkbook Set sht1 = wbThis.Sheets("Sheet1") Folder = "\\dne\ldc\research-dept\3 CEEMEA\15. EMB\Turkey\TLC Overnight & Weekly Reports\weekly (majeed)\" Fname = Dir(Folder) While (Fname <> "") Set wbTarget = Workbooks.Open(Filename:=Folder & Fname) wbTarget.Activate Range("b3:i102").Copy wbThis.Activate 'Just add this line: lastrow = sht1.Range("b1").End(xlDown).Row + 1 'And alter this one as follows: sht1.Range("B" & lastrow).PasteSpecial Fname = Dir 'close the overnight's file wbTarget.Close Wend End Sub 

Answer 3

你如何将sht1.Range("b1:i102")为variables而不是常量？

就像是：

 Dim x As Long Dim y As Long x = 1 y = 1 Dim rng As Range Set rng = Range("b"&x ,"i"&y) 

然后使用：

 sht1.rng 

只要记住在while语句的末尾添加x = x+100 and y = y +100 （所以它会更新每个粘贴之间的新值）。

Answer 4

你为什么不放置柜台？ 喜欢这个：

 Dim counter As Long counter = 1 

接着：

 While (Fname <> "") Set wbTarget = Workbooks.Open(Filename:=Folder & Fname) wbTarget.Activate Range("b3:i102").Copy wbThis.Activate 'Solution: sht1.Range("b" & counter & ":i" & counter + 99).PasteSpecial counter = counter + 100 Fname = Dir 'close the overnight's file wbTarget.Close Wend