Consolidating Files

  • Thread starter Thread starter Angela
  • Start date Start date
A

Angela

Have individual files for multiple days formatted in Excel
based on an extract from a Crystal Reports print format.
Each file contains about 9 columns and there is just one
column of data we want to extract and put in a single
spreadsheet; each column would be date specific to the
files that the data would be copied from.

Is there a way to do this other than writing a macro?
 
Angela,
Is there a way to do this other than writing a macro?

Manually, which we know you don't really want to do <vbg>.

The macro below will copy column G from each of the workbooks in the folder C:\Excel into a single sheet. It will only copy from
the sheet that is active when the file opens: if there are multiple sheets you can specify which sheet to copy from. It will put the
filename into row 1 of the new worksheet. If you want to use something other than filename, you will need to figure out what you
want and change that line.

There is the obvious limit of 256 columns, so you may need to split your files into separate folders - I think 254 is the actual
limit given the coded logic..... Change the folder path (where indicated) to your folder, which should have _only_ files of interest
in it. And change the G:G to the column you want to extract.

HTH,
Bernie
Excel MVP

Sub Consolidate()
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = "C:\Excel"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set Basebook = Workbooks.Add
For i = 1 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
Intersect(Range("G:G"), ActiveSheet.UsedRange.EntireRow).Copy _
Basebook.Worksheets(1).Range("IV1").End(xlToLeft).Offset(1, 1)
Basebook.Worksheets(1).Range("IV1").End(xlToLeft).Offset(0, 1).Value = myBook.Name
myBook.Close
Next i
Basebook.SaveAs Application.GetSaveAsFilename("Consolidated file.xls")
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub
 
Back
Top