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
Wikipedia
Search results
Wednesday, 1 January 2014
Consolidate all files with a Single click...
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment