macro to consolidate other excel files into one RRS feed

  • Question

  • I would like to post following request:

    On my network there is a folder called "a" with a changing number of subfolders. In each of these folders there is a changing number of excel files, all of them with different unknown names. There is also something the files have in common: they all have - beside Sheet1, Sheet2 and Sheet3 - a sheet callled "Name" with data starting at line 5 and in columns A till X. The number of filled lines is random per file.

    My question:

    I would like to make a consolidated excel file in which I can load all the different sheets callled "Name" of the different files. This consolidated excel file has the same format as all the other excel files, meaning it also has a sheet called "Name" (or we can call it "ConsolidatedName" to make it easier) and it captures the data starting line 5 and in columns A till X.
    I would like to add two more details on the right side; in column Y the name of the file where the data line comes from should appear and in column Z the name of the folder where the line (and the excel file of column Y) should appear.

    I allready started but it's not in an end state yet:

    Sub Consolidation()
     For Each fl In CreateObject("scripting.filesystemobject").getfolder("\\...\a").Files
     With Workbooks.Add(fl)
     ThisWorkbook.Sheets("Name").Cells(Rows.Count, 1).End(xlUp).Offset(1) = fl
     .Sheets("Name").UsedRange.Copy ThisWorkbook.Sheets("ConsolidatedName").Cells(Rows.Count, 1).End(xlUp).Offset(1)
     .Close False
     End With
     End Sub


    Tuesday, December 29, 2015 11:16 AM

All replies

  • Re:  consolidate files

    'Give the following code a try - note the notes.
    'It should be easy to add the names you need.
    'Note the "Notes"

     Option Compare Text
    'Opens each .xls file in the folder and moves the active sheet
    'to the workbook containing the code.
    'Jim Cone - Portland, Oregon USA - last modified March, 2008.

    Sub FilesToWorksheets_R3()
     On Error GoTo ThatHurt
     Dim objFSO    As Object
     Dim objFolder As Object
     Dim objFile   As Object
     Dim strPath   As String
     Dim strName   As String
     Dim blnTask   As Boolean

     If Val(Application.Version) >= 10 Then
     blnTask = Application.ShowWindowsInTaskbar
     Application.ShowWindowsInTaskbar = False
     End If
     Application.ScreenUpdating = False
    'Specify the folder...
     strPath = "C:\Program Files\Lavasoft\Ad-aware 6\Logs"  'Note <<< Use actual path

    'Use Microsoft Scripting runtime.
     Set objFSO = CreateObject("Scripting.FileSystemObject")
     Set objFolder = objFSO.GetFolder(strPath)

    'Check type of file in the folder and open file.
     For Each objFile In objFolder.Files
     If objFile.Name Like "*.xls" Then 'Note: <<< Change as needed
        strName = objFile.Name
        Application.StatusBar = strName
        Workbooks.Open objFile
       'Note: Use actual sheet name below, not "active sheet"... Worksheets("Sludge").
        ActiveSheet.Name = Left$(strName, 30)
        ActiveSheet.Move after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        Workbooks(strName).Close savechanges:=False
      End If
     Next 'objFile
     On Error Resume Next
     Application.ShowWindowsInTaskbar = blnTask
     Application.StatusBar = False
     Application.ScreenUpdating = True
     Set objFSO = Nothing
     Set objFolder = Nothing
     Set objFile = Nothing
     Exit Sub

     MsgBox "Error " & Err.Number & "  " & Err.Description, , "Text File Creation"
     Resume CloseOut
    End Sub

    Jim Cone
    Portland, Oregon USA
    https://goo.gl/IUQUN2 (Dropbox)
    (free & commercial excel add-ins & workbooks)

    • Edited by James Cone Tuesday, October 25, 2016 1:20 AM
    Wednesday, December 30, 2015 3:31 AM
  • Please see this solution.


    This may help as well, but the link above is probably better for you.


    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.

    • Proposed as answer by André Santo Wednesday, December 30, 2015 10:25 AM
    Wednesday, December 30, 2015 5:41 AM