Mass data import from 200 files... automatically?

If the files are always stored in the same location with the same file names then you could just create the string for the file and then open the file.

strfile="D:\desktop\" & filecount & ".xls"
open file strfile

If the files are diffent each time, then this is a way that you can select the files you want to work with.

You select all files that are to be opened, and then you go through the files one by one opening them, and taking the information you need.


[code]
'Open file selection menu
FName = Application.GetOpenFilename("Excel Files,*.xls", 1, "Select all files", , True)
If TypeName(FName) = "Boolean" Then
MsgBox "You didn't select a file"
Exit Sub
End If

'Moves through array of file name until all have been processed
For f = 1 To UBound(FName)
Debug.Print "Selected file #" & f & ": " & FName(f)
Application.ScreenUpdating = False
Workbooks.OpenText FileName:=FName(f)
Call Harvest
Next f
ActiveWindow.Close
[\code]

Here is the jist of the code.

Here is what you want to do:

You want to count through all the file number so you have the loop.
Next you construct the string that tells where to go for the files
Select the range of cells
close workbook
Paste selection into your new file
Repeat

PHP Code: 


for x = 1 to 200 
strFile="C:\test\data\" & x & ".xls"
openfile strfile

range("A3:R25").select
Selection.copy
activeworkbook.close

Cells(x*2,1).paste 

next x 


OK thanks, the code is clear, but I get a compiling error everytime I try to run the makro.
Heres what I do:

Open Master file, enter VBA and create makro for Sheet1.

PHP Code: 

Sub MassImport()
For x = 1 To 200
strfile = "C:\test\files\" & x & ".xls"
openfile strfile

Range("A3:R25").Select
Selection.Copy
ActiveWorkbook.Close

Cells(x * 2, 1).Paste

Next x
End Sub 


When I try to run it, I always get the error message: Error during compiling and the highlighted area points to "Sub Massimport()"

thanks for the help!
A2k

PHP Code: 

Sub MassImport()
For x = 1 To 200
strfile = "C:\test\files\" & x & ".xls"
Workbooks.OpenText strfile

Range("A3:R25").Select
Selection.Copy
ActiveWorkbook.Close

Cells(x * 2, 1).Paste

Next x
End Sub 


wonderful, thanks for the great support. I tried both versions and they equally work absolutely fine. just one quick question for Martin D. Wilson and his solution:

Can you define from which cell onwards I want the script to start pasting? Default is A1, but I would like to add some headlines, thus would need a paste starting from A2, but if I change the parking cell in the script, nothing happens...

OK, I have one more short question for you people.
After I have imported all of my files, i figured i have a few entries twice or three times. But since I am talking about 7000 lines, i do not want to start looking through every entry and check if it only exists once, respectively dont want to sort all the lines and see any double entries.

Is there a way a macro can check if the contents from (eg) A1:K1 exist again in that exact order somewhere between A1:K7000 ?
the good thing is that the entry would be EXACTLY the same, but I still have a few which are a just a little bit different and those must be kept.

Again, thanks for all the great support!
A2k

To remove the duplicates you can use Advanced Filter. You Find it on the Data-Filter menu.

Select : "Copy to another location" and "Unique Records only".
"List Range", is the data you want to filter and "Copy To" is where you want to paste the result (probably another sheet). Leave "Criteria range" empty.