Need to merge 1500 files into 1!!!

  • Thread starter Thread starter rglasunow
  • Start date Start date
R

rglasunow

I currently have 1500 different Excel files from a survey. The top ro
contains the question and the 2nd row contains the answers. What
would like to do if find a way to take the information in the 2nd ro
of each file and dump it into one spreadsheet.

I can write a macro to copy paste the information, however, the file
that I am copying the information from are obviously named differentl
and I am not sure how to tell Excel to paste in the next available ro
only a particular cell.

Is there a way that I could automate this entire process instead o
opening up each file and copy paste?

Any help in the right direction is greatly appreciated!
Thanks in advance
 
Try something like the following code:

Sub MergeFiles()
Dim FName As String
Dim WB As Workbook
Dim Dest As Range
Const FOLDERNAME = "C:\Temp" '<<< CHANGE
ChDrive FOLDERNAME
ChDir FOLDERNAME

Set Dest = Range("A1")
FName = Dir("*.xls")

Do Until FName = ""
Set WB = Workbooks.Open(FName)
WB.Worksheets(1).Rows(2).Copy Destination:=Dest
WB.Close savechanges:=False
Set Dest = Dest(2, 1)
FName = Dir()
Loop
End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
 
Thank you so much for your help. This worked great. You just saved me
from Ctrl+C & Ctrl+V 1500 times!!!

I just have one more question.

Under this command - Do Until FName = ""

Is this going through the folder I selected in alphabetical order?
Thank you,
Ryan
 
Is this going through the folder I selected in alphabetical order?
Yes

You can use this for example to fill in the filename also
<basebook.Worksheets(1).Cells(rnum, 4) = mybook.Name>
4 is the column, if you copy a range more then 3 columns width then change this

Set mybook = Workbooks.Open(FNames)
Set sourceRange = mybook.Worksheets(1).Range("a1:c3")
a = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, 1)
sourceRange.Copy destrange
basebook.Worksheets(1).Cells(rnum, 4) = mybook.Name
 
Back
Top