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

问题

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

Task list to achieve this:

I want to loop over all the files in a folder
open the file,
copy this range "B3:I102"
paste it into the 1st sheet of the active workbook
repeat but paste new data underneath

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

回答1:

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

回答2:

I see you already added a long variable for this, so do a lookup on the last row before you paste. Also, paste in a single cell in case of varying amounts of data.

I altered your script as follows.

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

回答3:

How about you define sht1.Range("b1:i102") as variables instead of constants?

Something like:

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

And then use:

sht1.rng

Just remember to add x = x+100 and y = y +100 at the end of your while statement (so it will update new values between each paste.)

回答4:

Why don't you place a counter? Like this:

Dim counter As Long
counter = 1

And then:

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

回答5:

You can addbelow section as step 5. I have used offset with Variable incremented in loop

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

来源：https://stackoverflow.com/questions/44433888/excel-vba-loop-over-files-in-folder-copy-range-paste-in-this-workbook

标签

excel

vba

excel-vba

loops

copy-paste