Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
 
Posts: n/a
Default Consolidation of Files

I have 88 files that contain the same number of columns (without column
headings) and I need to combine them into one consolidated file.

Please advise.

  #2   Report Post  
Posted to microsoft.public.excel.misc
Trevor Shuttleworth
 
Posts: n/a
Default Consolidation of Files

Not the answer to your prayers but this code does the sort of thing you want
to do:

You'll need to adjust it but the comments try to explain what's going on and
why. Hope it helps.

Regards

Trevor


Option Explicit
'
================================================== ==============================

Sub Get_IDandV_Data()

Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objSubfolder As Scripting.Folder
Dim objFile As Scripting.File
Dim iRow As Long
Dim IDV_Folder As String
Dim CopyBook As Workbook
Dim TargetRange As Range
Dim mLastRow As Long

' locate the folder where the ID&V data files are stored
' for this code to work, they must be in the same folder as This Workbook
IDV_Folder = ActiveWorkbook.Path

' switch Screen Updating off to make processing faster
Application.ScreenUpdating = False
' switch Calculation off to make processing faster
Application.Calculation = xlCalculationManual

' create a link to the ID&V folder using the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(IDV_Folder)

' process each file in the ID&V folder
For Each objFile In objFolder.Files
' check it is an Excel workbook
If objFile.Type = "Microsoft Excel Worksheet" Then
' and that it is *not* This Workbook
If objFile.Name < ThisWorkbook.Name Then
' create a reference to the workbook being processed
Set CopyBook = Workbooks.Open _
(Filename:=objFolder.Path & "\" &
objFile.Name)
' copy all the rows in the workbook being processed
CopyBook.Sheets("Sheet1").UsedRange.Copy
' activate This Workbook
ThisWorkbook.Activate
' and copy the data to the next available/blank row
With Sheets("List")
mLastRow =
WorksheetFunction.Max(Range("A65536").End(xlUp).Ro w, _
Range("B65536").End(xlUp).Row,
_
Range("C65536").End(xlUp).Row,
_
Range("D65536").End(xlUp).Row,
_
Range("E65536").End(xlUp).Row,
_
Range("F65536").End(xlUp).Row)

Set TargetRange = .Range("A" & mLastRow + 1)
TargetRange.Offset(0, 5).Value = CopyBook.Name
TargetRange.Select
.Paste
' clear the dancing ants and the clipboard
Application.CutCopyMode = False
End With
' close the workbook being processed without saving it
CopyBook.Close savechanges:=False
End If
End If
Next

' switch Calculation back on so the formulae will calculate properly
Application.Calculation = xlCalculationAutomatic

mLastRow = WorksheetFunction.Max(Range("A65536").End(xlUp).Ro w, _
Range("B65536").End(xlUp).Row, _
Range("C65536").End(xlUp).Row, _
Range("D65536").End(xlUp).Row, _
Range("E65536").End(xlUp).Row, _
Range("F65536").End(xlUp).Row)

' copy the workbook names down for cross referencing, if necessary
With Range("G2")
.FormulaR1C1 = "=IF(RC[-1]<"""",RC[-1],R[-1]C)"
.AutoFill Destination:=Range("G2:G" & mLastRow)
End With
' convert to values to "fix" the file name
With Range("G2:G" & mLastRow)
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
' clear the dancing ants and the clipboard
Application.CutCopyMode = False

' insert the Row number so that the original sequence can be restored, if
necessary
With Range("H2")
.FormulaR1C1 = "=ROW()"
.AutoFill Destination:=Range("H2:H" & mLastRow)
End With
' convert to values to "fix" the row
With Range("H2:H" & mLastRow)
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
' clear the dancing ants and the clipboard
Application.CutCopyMode = False

With Cells
' remove the borders
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
' remove "patterns"
.Interior.ColorIndex = xlNone
' align the data left and top, no wrap
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False

' finally, sort the data into Status, Surname, First name
.Sort Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("C2"), Order2:=xlAscending, _
Key3:=Range("D2"), Order3:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End With

' switch Screen Updating back on to display the end result
Application.ScreenUpdating = True

' job done ...

End Sub

'
================================================== ==============================

wrote in message
oups.com...
I have 88 files that contain the same number of columns (without column
headings) and I need to combine them into one consolidated file.

Please advise.



  #3   Report Post  
Posted to microsoft.public.excel.misc
 
Posts: n/a
Default Consolidation of Files

Thank you so much, Mr. Shuttleworth for the code. I'll will give it a
try.



Trevor Shuttleworth wrote:
Not the answer to your prayers but this code does the sort of thing you want
to do:

You'll need to adjust it but the comments try to explain what's going on and
why. Hope it helps.

Regards

Trevor


Option Explicit
'
================================================== ==============================

Sub Get_IDandV_Data()

Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objSubfolder As Scripting.Folder
Dim objFile As Scripting.File
Dim iRow As Long
Dim IDV_Folder As String
Dim CopyBook As Workbook
Dim TargetRange As Range
Dim mLastRow As Long

' locate the folder where the ID&V data files are stored
' for this code to work, they must be in the same folder as This Workbook
IDV_Folder = ActiveWorkbook.Path

' switch Screen Updating off to make processing faster
Application.ScreenUpdating = False
' switch Calculation off to make processing faster
Application.Calculation = xlCalculationManual

' create a link to the ID&V folder using the File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(IDV_Folder)

' process each file in the ID&V folder
For Each objFile In objFolder.Files
' check it is an Excel workbook
If objFile.Type = "Microsoft Excel Worksheet" Then
' and that it is *not* This Workbook
If objFile.Name < ThisWorkbook.Name Then
' create a reference to the workbook being processed
Set CopyBook = Workbooks.Open _
(Filename:=objFolder.Path & "\" &
objFile.Name)
' copy all the rows in the workbook being processed
CopyBook.Sheets("Sheet1").UsedRange.Copy
' activate This Workbook
ThisWorkbook.Activate
' and copy the data to the next available/blank row
With Sheets("List")
mLastRow =
WorksheetFunction.Max(Range("A65536").End(xlUp).Ro w, _
Range("B65536").End(xlUp).Row,
_
Range("C65536").End(xlUp).Row,
_
Range("D65536").End(xlUp).Row,
_
Range("E65536").End(xlUp).Row,
_
Range("F65536").End(xlUp).Row)

Set TargetRange = .Range("A" & mLastRow + 1)
TargetRange.Offset(0, 5).Value = CopyBook.Name
TargetRange.Select
.Paste
' clear the dancing ants and the clipboard
Application.CutCopyMode = False
End With
' close the workbook being processed without saving it
CopyBook.Close savechanges:=False
End If
End If
Next

' switch Calculation back on so the formulae will calculate properly
Application.Calculation = xlCalculationAutomatic

mLastRow = WorksheetFunction.Max(Range("A65536").End(xlUp).Ro w, _
Range("B65536").End(xlUp).Row, _
Range("C65536").End(xlUp).Row, _
Range("D65536").End(xlUp).Row, _
Range("E65536").End(xlUp).Row, _
Range("F65536").End(xlUp).Row)

' copy the workbook names down for cross referencing, if necessary
With Range("G2")
.FormulaR1C1 = "=IF(RC[-1]<"""",RC[-1],R[-1]C)"
.AutoFill Destination:=Range("G2:G" & mLastRow)
End With
' convert to values to "fix" the file name
With Range("G2:G" & mLastRow)
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
' clear the dancing ants and the clipboard
Application.CutCopyMode = False

' insert the Row number so that the original sequence can be restored, if
necessary
With Range("H2")
.FormulaR1C1 = "=ROW()"
.AutoFill Destination:=Range("H2:H" & mLastRow)
End With
' convert to values to "fix" the row
With Range("H2:H" & mLastRow)
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
' clear the dancing ants and the clipboard
Application.CutCopyMode = False

With Cells
' remove the borders
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
' remove "patterns"
.Interior.ColorIndex = xlNone
' align the data left and top, no wrap
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False

' finally, sort the data into Status, Surname, First name
.Sort Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("C2"), Order2:=xlAscending, _
Key3:=Range("D2"), Order3:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End With

' switch Screen Updating back on to display the end result
Application.ScreenUpdating = True

' job done ...

End Sub

'
================================================== ==============================

wrote in message
oups.com...
I have 88 files that contain the same number of columns (without column
headings) and I need to combine them into one consolidated file.

Please advise.


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Sharing read-write Excel 2003 files ttt8262 Excel Discussion (Misc queries) 0 April 1st 06 09:39 PM
Graphs in Other Files do not Update Dolphinv4 Excel Discussion (Misc queries) 0 October 21st 05 10:38 AM
Recently Used File List - 2002 Contains 'Temp' Files Keith972002 Excel Discussion (Misc queries) 0 July 26th 05 01:46 PM
merging my excel files Donna YaWanna Excel Discussion (Misc queries) 1 June 14th 05 12:53 AM
Cannot access read-only documents. tomgillane Excel Discussion (Misc queries) 14 February 7th 05 10:53 PM


All times are GMT +1. The time now is 12:44 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"