VBA to consolidate files

[debraj_patra1]

Hi all,

i have multiple similar files from different countries to be consolidated by me, i want a VBA to consolidate the data from single files to a consolidated file. below are the basic requirements.

Source File name:- file1 to file 15.
Destination file name:- consol File.
Source sheet name(sample):- IT P&L by bucket

1. All files have same headers.
2. All files have multiple worksheets(all worksheet to be consolidated).
3. All files would be located in the same folder(month wise separate folder).
4. there may be row breakers in source sheets.


Thanks in advance.

Regards
Debraj Patra

 

[ranman256]

give this a try,
usage:
getFilesInDir "c:\temp"

Private Sub getFilesInDir(ByVal pvSrcDir)
Dim FSO, oFolder, oFile, oRX
Dim sCriteria As String, sFile As String
Dim iCnt As Integer
Dim vXFmt, vNewFile
Dim wbApp As Workbook, wbFile As Workbook
Dim wsTarg As Worksheet


On Error GoTo errGetFiles


Set wbApp = ActiveWorkbook
If Right(pvSrcDir, 1) <> "\" Then pvSrcDir = pvSrcDir & "\"


Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(pvSrcDir)


Sheets.Add
Set wsTarg = ActiveSheet
For Each oFile In oFolder.Files
  If InStr(oFile.Name, ".xls") > 0 Then            'open file here
         iCnt = iCnt + 1
         sFile = pvSrcDir & oFile.Name
         Workbooks.Open sFile
         Set wbFile = ActiveWorkbook
         Sheets("IT P&L by bucket").Select
           'copy the data
         Range("a1").Select
         ActiveSheet.UsedRange.Select
         Selection.Copy
         wbApp.Activate
         wsTarg.Select
         FindNextFreeRow
         ActiveSheet.Paste
         Application.CutCopyMode = False
         
         wbFile.Close False
  End If
Next
MsgBox "Done"
Set wbApp = Nothing
Set wbFile = Nothing
Set wsTarg = Nothing


endit:
Set oFile = Nothing
Set oFolder = Nothing
Set FSO = Nothing
Exit Sub


errGetFiles:
  MsgBox Err.Description, , Err
End Sub




Private Sub FindNextFreeRow()
Range("A1").Select
Select Case True
   Case ActiveCell.Value = ""
   Case ActiveCell(1, 0).Value = ""
        NextRow
   Case Else
        FarDown
        NextRow
End Select
End Sub

 

[debraj_patra1]

Hi, Thanks for the help, but i am not able to run the macro, could you please assist with the process how to run the macro in excel 2016.

 

[ranman256]

enter VBE, alt-F11
menu, insert , module,
paste the code into this module, save
insert , procedure, name it whatever....MyMacro

insert this code:
getFilesInDir "c:\temp"

rename the folder,"c:\temp", to your folder where your folder name
then run : MyMacro

if you want to run this code for ANY file, then the module must be in your PERSONAL.xlsb
in any excel sheet,
click record macro
change THIS WORKBOOK to PERSONAL WORKBOOK
click any cell
stop macro.
now you have a personal workbook, (seen in the VBE projects pane)
paste the code here.
save