Collect data from Excel files

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

tim - 22 May 2008 13:32 GMT

Hi
I have about 60 (incresing everyday) .xls files in a folder called
"customers invoices"

Format of all the files is the same.
How can I exract data from all these files (from this folder)?

I need to get data from
A6
B14
F34
F36

Any suggestion please.

Reply to this Message

Joel - 22 May 2008 13:56 GMT

Change folder in code below to the full directory name you require. The code
will put all the data in the active worksheet in column A - D. I also put
the filename in column E.

Sub getdata()

Folder = "c:\temp\"

Set oldsht = ActiveSheet
RowCount = 1

FName = Dir(Folder & "*.xls")
Do While FName <> ""
Set newbk = Workbooks.Open(Filename:=Folder & FName)
With oldsht
.Range("A" & RowCount) = newbk.ActiveSheet.Range("A6")
.Range("B" & RowCount) = newbk.ActiveSheet.Range("B14")
.Range("C" & RowCount) = newbk.ActiveSheet.Range("F34")
.Range("D" & RowCount) = newbk.ActiveSheet.Range("F36")
.Range("E" & RowCount) = FName
End With
newbk.Close savechanges:=False
FName = Dir()
Loop
End Sub

> Hi
> I have about 60 (incresing everyday) .xls files in a folder called
[quoted text clipped - 12 lines]
>
>

Reply to this Message

Joel - 22 May 2008 13:57 GMT

I forgot to increment the RowCount

Sub getdata()

Folder = "c:\temp\"

Set oldsht = ActiveSheet
RowCount = 1

FName = Dir(Folder & "*.xls")
Do While FName <> ""
Set newbk = Workbooks.Open(Filename:=Folder & FName)
With oldsht
.Range("A" & RowCount) = newbk.ActiveSheet.Range("A6")
.Range("B" & RowCount) = newbk.ActiveSheet.Range("B14")
.Range("C" & RowCount) = newbk.ActiveSheet.Range("F34")
.Range("D" & RowCount) = newbk.ActiveSheet.Range("F36")
.Range("E" & RowCount) = FName
End With
RowCount = RowCount + 1
newbk.Close savechanges:=False
FName = Dir()
Loop
End Sub

> Hi
> I have about 60 (incresing everyday) .xls files in a folder called
[quoted text clipped - 12 lines]
>
>

Reply to this Message

stefan onken - 22 May 2008 14:10 GMT

hi Tim,
you could use an add-in
http://xcell05.free.fr/morefunc/english/index.htm
the function is indirect.ext
http://xcell05.free.fr/morefunc/english/indirect.ext.htm

or you need a macro, that in a loop every workbook of a directory
-opens, copy/paste data, closes
if you want a macro, where/how should the data be pasted?

stefan

> Hi
> I have about 60 (incresing everyday) .xls files in a folder called
[quoted text clipped - 10 lines]
>
> Any suggestion please.

Reply to this Message

tim - 22 May 2008 14:53 GMT

thanks guys.
Joel I am sorry to forgot to mention.

The sheet name in the file I want data from is "invoice".

Data collected to be pasted in the sheet I am working called "OverView".

What changes I ned to make and where to pu the code?

regards

> Hi
> I have about 60 (incresing everyday) .xls files in a folder called
[quoted text clipped - 10 lines]
>
> Any suggestion please.

Reply to this Message

Ron de Bruin - 22 May 2008 20:43 GMT

See also
http://www.rondebruin.nl/merge.htm

Or
http://www.rondebruin.nl/summary2.htm

Signature

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

> Hi
> I have about 60 (incresing everyday) .xls files in a folder called
[quoted text clipped - 10 lines]
>
> Any suggestion please.

Reply to this Message

tim - 22 May 2008 23:59 GMT

Thanks it was really helpful link.

I would still go for Joel suggested code.

Joel I have tried the following code but no luck. any further help would be
much appriciated.

Sub getdata()

Folder = "c:\customers_invoices"

Set oldsht = ActiveSheet
RowCount = 1

FName = Dir(Folder & "*.xls")
Do While FName <> ""
Set newbk = Workbooks.Open(Filename:=Folder & FName)
With oldsht
.Range("A" & RowCount) = newbk.ActiveSheet.Range("A6")
.Range("B" & RowCount) = newbk.ActiveSheet.Range("B14")
.Range("C" & RowCount) = newbk.ActiveSheet.Range("F34")
.Range("D" & RowCount) = newbk.ActiveSheet.Range("F36")
.Range("E" & RowCount) = FName
End With
RowCount = RowCount + 1
newbk.Close savechanges:=False
FName = Dir()
Loop
End Sub

> See also
> http://www.rondebruin.nl/merge.htm
[quoted text clipped - 16 lines]
>>
>> Any suggestion please.

Reply to this Message