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