Macro for retreiving info from many workbooks

[NPike]

Hi please can somebody help. (I am using Microsoft Excel 2002)

I have 1000's of workbooks (with identicle layouts, different data). I am wanting to summarise all this data in one Master Summary workbook. Can someone please help with the Macro to do this.

In more detail,

All my workbooks are named alphanumerically: A1234, A2754, B2703, A1238 613, B2475 314 etc.

The tab in each workbook I want to retreieve data from is named "Scheme Overview"

The cell reference on this tab is D31:F31 (if it matters that the cell is merged, I can live with cell reference D31).

All the workbooks will be kept in the same file directory.

The summary workbook has the workbook names e.g. A1234, starting in column E, row 11.

The retrieved data from the macro wants to start in column F, row 11.

Is this possible? And is it possible to not just pull the data, but also the formula. E.g. ='[A1234.xls]Scheme Overview'!$D$31:$F$31

Also,

From the same tab as above on the 1000's of workbooks I also want to pull data in each cell from AJ101 through to IV101 into the summary workbook. In the summary workbook the tab is called Areas of Concern. The data is to be pulled to cell D8 through to D117.

Any help is much appreciated.

Thanks in advance.

Neil.

 

[venkat1926]

try this thread ( the second soluion given by Shailesh Shah

http://www.pcreview.co.uk/forums/thread-962632.php

 

[ravishankar]

HI
Save this macro in a new workbook in the same folder as other files.. It lists files in the folder (Col A) and pulls D1 to F1(col B to D) and AJ101 to IV101 (col E to HQ) (With this method, formula can’t be pulled)

Sub NP()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
Dim z  As Long, e As Long, g As Long<o:p></o:p>
Dim f As String<o:p></o:p>
Cells(1, 1) = "=cell(""filename"")"<o:p></o:p>
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"<o:p></o:p>
Cells(3, 1).Select<o:p></o:p>
f = Dir(Cells(1, 2) & "*.xls")<o:p></o:p>
Do While Len(f) > 0<o:p></o:p>
ActiveCell.Formula = f<o:p></o:p>
ActiveCell.Offset(1, 0).Select<o:p></o:p>
f = Dir()<o:p></o:p>
Loop<o:p></o:p>
z = Cells(Rows.Count, 1).End(xlUp).Row<o:p></o:p>
For e = 3 To z<o:p></o:p>
If Cells(e, 1) <> ActiveWorkbook.Name Then<o:p></o:p>
For g = 1 To 3<o:p></o:p>
Cells(1, 3) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Scheme Overview'!" & Chr(g + 67) & 31<o:p></o:p>
Cells(e, g + 1) = Cells(1, 3)<o:p></o:p>
Next g<o:p></o:p>
For h = 36 To 256<o:p></o:p>
If h Mod 26 = 0 Then<o:p></o:p>
k = 26<o:p></o:p>
Else<o:p></o:p>
k = h Mod 26<o:p></o:p>
End If<o:p></o:p>
j = Chr(Round((h / 26) + 0.49, 0) + 63) & Chr(k + 64)<o:p></o:p>
Cells(1, 3) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Scheme Overview'!" & j & 101<o:p></o:p>
Cells(e, 5 + h) = Cells(1, 3)<o:p></o:p>
Next h<o:p></o:p>
End If<o:p></o:p>
Next e<o:p></o:p>
MsgBox "collating is complete."<o:p></o:p>
End Sub

Ravi