Compiling Workbook Data..

[Rajan_Verma]

Many times Analysts need to compile data Form Different workbook into one workbook..and its a very time consuming task for them to Open all file one by one and manually copy and paste data into a single worksheet..So in that situation this Code provides a excellent way to do that work automatically and saves lot of time if All Workbook Contain the similar Data with One worksheet..Just Run this Code and get a Compiled File.





Sub Compile()
On Error GoTo Err_Clear:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Fso As New Scripting.FileSystemObject
Dim Path As String
Dim Counter
Dim File As File
Dim FOlder As FOlder
Dim wb As Workbook
Dim ws As Worksheet
Dim AcWb As Workbook


Application.FileDialog(msoFileDialogFolderPicker). Title = "Select Folder to Pick Files"
Application.FileDialog(msoFileDialogFolderPicker). Show
Path = Application.FileDialog(msoFileDialogFolderPicker). SelectedItems(1) & "\"
If Path = "" Then Exit Sub

Application.FileDialog(msoFileDialogFolderPicker). Title = "Select Folder to Save Compiled File"
CompilePath = Application.FileDialog(msoFileDialogFolderPicker). Show
compiledPath = Application.FileDialog(msoFileDialogFolderPicker). SelectedItems(1) & "\"
If compiledPath = "" Then Exit Sub

Set AcWb = ThisWorkbook
AcWb.Worksheets.Add.Name = "Index"

Set FOlder = Fso.GetFolder(Path)

For Each File In FOlder.Files
Counter = Counter + 1
Set wb = Workbooks.Open(Path & File.Name)

If Application.Ready = True Then
wb.Sheets("Index").UsedRange.Copy AcWb.Worksheets("index").Range("A" & Rows.Count).End(xlUp)
Application.CutCopyMode = False
wb.Close
End If

Next
If Counter > 0 Then
AcWb.SaveAs compiledPath & "Compiled"
End If
Err_Clear:
Err.Clear
Resume Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True
If Counter < 1 Then
MsgBox "No File Found For Compile", vbInformation
Else
MsgBox Counter & " File Has been Compiled, Please Find your File at" & vbCrLf & compiledPath, vbInformation
End If
End Sub

[rusttem]

For this to work it is necessary:

Load the Visual Basic Editor (ALT-F11)
Select Tools - References from the drop-down menu
A listbox of available references will be displayed
Tick the check-box next to 'Microsoft Scripting Runtime'
The full name and path of the scrrun.dll file will be displayed below the listbox
Click on the OK button


Within Excel you need to set a reference to the VB script run-time library. The relevant file is usually located at \Windows\System32\scrrun.dll

Sorry for my english

Question:
How to collect data from only the needed cells?
How to change the code?

[Rajan_Verma]

Change the Range to Copy in the below line

wb.Sheets("Index").UsedRange.Copy AcWb.Worksheets("index").Range("A" & Rows.Count).End(xlUp)

Regards
Rajan.

[rusttem]

What can replace the UsedRange, if you want to select data from 2-3 different cell

[Rajan_Verma]

Union(cell1,cell2,cell3)