Excel VBA-循环浏览文件夹中的文件，复制范围并粘贴到此工作簿中 [英] Excel VBA - loop over files in folder, copy range, paste in this workbook

问题描述

我有500个带有数据的excel文件.我会将所有这些数据合并到一个文件中.

I have 500 excel files with data. I would merge all this data into one file.

要实现这一目标的任务列表:

Task list to achieve this:

1. 我想遍历文件夹中的所有文件
2. 打开文件
3. 复制此范围"B3:I102"
4. 将其粘贴到活动工作簿的第一张纸上
5. 重复但在其下粘贴新数据

我已经完成了任务1-4，但是我需要任务5的帮助，最后一点-将数据粘贴到现有数据下并使其动态化.我在代码中以"####"突出显示了这一点.

I've done task 1-4 but i need help with task 5, last bit - pasting the data under the existing data and making it dynamic. I've highlighted this bit with '#### in my code.

这是我的代码，是我根据其他人的问题整理而成的:)

Here is my code which I've put together from other people's question :)

关于如何执行此操作的任何建议?

Any suggestions on how to do this?

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

推荐答案

我认为使用变量比复制方法有用.

I think using variant is useful than copy method.

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

这篇关于Excel VBA-循环浏览文件夹中的文件，复制范围并粘贴到此工作簿中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！