Wednesday, July 6, 2011

Compiling Workbooks :-

if you have Many Workbooks with Data in Same Format and You want to Compile all them with in a Single workbook you can use below Mention Code :-





Sub Compile()
On Error GoTo Err_Clear:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Fso As New Scripting.FileSystemObject
Dim Path As String

Application.FileDialog(msoFileDialogFolderPicker).Title = "Select Folder to Pick Downloaded Bills"
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
 
 
Dim Counter
Dim File As File
Dim FOlder As FOlder
Dim wb As Workbook
Dim ws As Worksheet
Dim AcWb As Workbook
Set AcWb = ActiveWorkbook
             ActiveWorkbook.Sheets.Add
             ActiveSheet.Name = "Index"

Set FOlder = Fso.GetFolder(Path)

        For Each File In FOlder.Files
         

             Counter = Counter + 1
             Set wb = Workbooks.Open(Path & File.Name)
                                 wb.Sheets("Index").Activate
                             
                                 ActiveSheet.UsedRange.Copy
                                  AcWb.Sheets("Index").Activate
                                  Range("A1000000").End(xlUp).Select
                                  ActiveSheet.Paste
                                 Application.CutCopyMode = False
                                 wb.Close
        Next
If Counter > 0 Then
AcWb.SaveAs compiledPath & "Compiled", xlExcel12
AcWb.Close
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


No comments: