Wikipedia

Search results

Wednesday 1 January 2014

Consolidate all files with a Single click...


Sub Consolidation()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim MasterRowCount As Long
Dim FileRowCount As Integer
Dim MyWkb As String
Dim FileColCount As Integer
Dim fl As File
Dim fldr As Folder
Dim fso As FileSystemObject

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
MyWkb = .SelectedItems(1) & "\"
End With

Set fso = New FileSystemObject
Set fldr = fso.GetFolder(MyWkb)

    For Each fl In fldr.Files
       
        MasterRowCount = Master.Cells(Rows.Count, "a").End(xlUp).Row + 1 ' I changed Sheet1 name from Properties window as "Master"
        Workbooks.Open (fl.Path)
        Sheets(1).Activate
        FileRowCount = Sheets(1).Cells(Rows.Count, "a").End(xlUp).Row
        FileColCount = Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
        Range("a2:" & Range("a2").End(xlToRight).End(xlDown).Address).Select
        Selection.Copy
        Application.DisplayAlerts = False
        ActiveWorkbook.Close
        Workbooks("MasterFile").Activate
        Master.Activate
        Cells(MasterRowCount, 1).PasteSpecial (xlPasteAll)
        Application.CutCopyMode = False
        Sheets(1).Range("A1").Select
       
    Next fl

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "Done", vbInformation, "Consolidation"

End Sub

No comments:

Post a Comment