Excel VBA - 遍历文件夹中的文件，复制范围，粘贴到此工作簿中

Question

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

实现这个的任务列表：

我想遍历文件夹中的所有文件
打开文件，
复制这个范围"B3:I102"
粘贴到活动工作簿的第一个sheet
重复但在下面粘贴新数据

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

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

关于如何做到这一点有什么建议吗？

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 CEEMEA. 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

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

我修改了你的脚本如下。

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 CEEMEA. 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 2

如何将 sht1.Range("b1:i102") 定义为变量而不是常量？

类似于：

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 3

你为什么不放一个柜台？像这样：

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

Answer 4

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

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 CEEMEA. 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 5

您可以在第 5 步添加下面的部分。我在循环中使用了变量递增的偏移量

Dim i as Long
Range("B1").Select     // 'select the column where you want to paste value
ActiveCell.Offset(i, 0).Select     //'place the offset counter with variable 
sht1.Range("b1:i100").PasteSpecial
i=i+100     //'increment the offset with the number of data rows

Excel VBA - 遍历文件夹中的文件，复制范围，粘贴到此工作簿中

Excel VBA - loop over files in folder, copy range, paste in this workbook

excel

vba

loops

copy-paste