Extracting Data

[Alex Burman]

I have a request:

I have a number of Excel files created from the same template that was
designed for a single page report. They are all in various subdirectories
under a main directory. I would like to be able identify the files, extract
the rows of data from each file and combine it into a new master list (which
will eventually replace toe old ones).

The template contains a list of up to 29 rows of data. If the first cell of
a row has data I would like to copy the whole row to the master spreadsheet.

Could someone write me a short macro that will search for an Excel file and
copy a specified range to a master file?

[Bill Manville]

Alex Burman wrote:
> Could someone write me a short macro that will search for an Excel file and
> copy a specified range to a master file?
>

Looks as though no-one is feeling altruistic enough to do so.

The newsgroups are not intended as a means of getting your work done for
nothing<grin>, but rather to provide help if you have tried to do something
and failed.

To get you started, here is some old code of mine that will process all Excel
files in a directory structure. All you need to do is to work out some code
to put in the ProcessFiles procedure at <<<<<<<< to extract the information
from the workbook and append it to your master sheet. If you get stuck on
that, come back.

---
Dim aFiles() As String, iFile As Integer

Sub ListXLSFilesInDirectoryStructure()
iFile = 0
ListFilesInDirectory "D:\TEMP\" ' change the top level as you wish
MsgBox iFile & " files found"
ProcessFiles
End Sub

Sub ListFilesInDirectory(Directory As String)
Dim aDirs() As String, iDir As Integer, stFile As String

' use Dir function to find files and directories in Directory
' look for directories and build a separate array of them
' note that Dir returns files as well as directories when vbDirectory
specified
iDir = 0
stFile = Directory & Dir(Directory & "*.*", vbDirectory)
Do While stFile <> Directory
If Right(stFile, 2) = "\." Or Right(stFile, 3) = "\.." Then
' do nothing - GetAttr doesn't like these directories
ElseIf (GetAttr(stFile) And vbDirectory) = vbDirectory Then
' add to local array of directories
iDir = iDir + 1
ReDim Preserve aDirs(1 To iDir)
aDirs(iDir) = stFile
ElseIf UCase(Right(stFile, 4)) = ".XLS" Then
' add to global array of files
iFile = iFile + 1
ReDim Preserve aFiles(1 To iFile)
aFiles(iFile) = stFile
End If
stFile = Directory & Dir()
Loop

' now, for any directories in aDirs call self recursively
If iDir > 0 Then
For iDir = 1 To UBound(aDirs)
ListFilesInDirectory aDirs(iDir) & Application.PathSeparator
Next iDir
End If
End Sub

Sub ProcessFiles()
Dim WB As Workbook
For iFile = 1 To UBound(aFiles)
Set WB = Workbooks.Open(aFiles(iFile))
' process your files <<<<<<<<<
WB.Close savechanges:=False ' change to True if you need to save changes
Next
End Sub

Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - respond to newsgroup