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.

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.

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.