Consolidate files from multiple file folders

[GuyFromStl]

First, thanks for everyone who helped provide code to consolidate files into a single folder. I would like to take this a step further if possible.

Each month there will be a number of directories which will vary but the naming convention will be the same

Example for August:</SPAN>
S01234.FY14.Aug
S02345.FY14.Aug
S03456.FY14.Aug</SPAN>
Example for September:</SPAN>
S01234.FY14.Sep
S02345.FY14.Sep
S03456.FY14.Sep

I would then like to be able to execute the marco at the start of each month to consolidate the files by month together. I envision this by either having a pop-up box asking for the 3 digit month or manually changing the code to reflect the month needed to pull.

The code I have so far is:</SPAN>
Dim sh As Worksheet, lr As Long, fPath As String, wb As Workbook, sh2 As Worksheet, fNm As String
Dim lstRw As Long, rng As Range
Set sh = Sheets(1) 'Edit name of master sheet
fPath = "C:\temp" 'Edit directory path
If Right(fPath, 1) <> "\" Then
fPath = fPath & "\"
End If
fNm = Dir(fPath & "*.xl*")
Do
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row 'Assumes Col A will be posting reference
Set wb = Workbooks.Open(fPath & fNm)
Set sh2 = wb.Sheets(1)
lstRw = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh2.Range("A2:A" & lstRw)
rng.EntireRow.Copy sh.Range("A" & lr + 1)
wb.Close False
fNm = Dir
Loop While fNm <> ""

 

[John_w]

Use the InputBox function to display a pop-up box asking for the month, or maybe just use the Format function to get the short month name. It's not clear if you want to consolidate the files for the current, next or previous month.

Put the code which consolidates all the files from one folder in a separate sub procedure and call it for each ".month" folder, passing the folder path and destination sheet as arguments.

 

[GuyFromStl]

This process will be done on a monthly basis so we should assume current month. I have done some digging on the InputBox function and have been unsuccessful at finding code that will work.

 

[John_w]

Try something like this for the user input:

    Dim monthName As String    
    monthName = InputBox("Enter month name", Default:=Format(Date, "mmm"))
    If monthName = "" Then Exit Sub   'Cancel clicked

Are the folder names always the same (apart from the month name)? And are there always 3 folders for each month? That's what your example shows.

 

[GuyFromStl]

The number of folders will vary each month

 

[John_w]

Try this. Before running, you must edit the code where indicated to set the path of the main folder which contains the monthly folders. Alternatively, you could add code (using Application.FileDialog(msoFileDialogFolderPicker)) so that the user can browse and select the main folder.

Public Sub Consolidate_Month_Files()

    Dim masterSheet As Worksheet
    Dim monthName As String
    Dim mainFolder As String
    Dim monthFolder As String, monthFolders() As String, n As Integer
    
    mainFolder = "C:\Path\To\Main Folder\"      'CHANGE THIS FOLDER PATH
    
    monthName = InputBox("Enter month name", Default:=Format(Date, "mmm"))
    If monthName = "" Then Exit Sub
    
    If Right(mainFolder, 1) <> "\" Then mainFolder = mainFolder & "\"
    monthFolder = Dir(mainFolder & "*" & monthName, vbDirectory)
    n = 0
    While monthFolder <> ""
        ReDim Preserve monthFolders(n)
        monthFolders(n) = monthFolder
        monthFolder = Dir
        n = n + 1
    Wend
    
    Set masterSheet = ThisWorkbook.Worksheets(1)
    
    For n = 0 To UBound(monthFolders)
        Consolidate_Files_in_Folder mainFolder & monthFolders(n), masterSheet
    Next
    
End Sub


Private Sub Consolidate_Files_in_Folder(folderPath As String, destinationSheet As Worksheet)

    Dim lr As Long, wb As Workbook
    Dim copyRange As Range
    Dim fileName As String
    
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    fileName = Dir(folderPath & "*.xl*")
    While fileName <> ""
        lr = destinationSheet.Cells(Rows.Count, "A").End(xlUp).Row 'last row in destination sheet column A
        Set wb = Workbooks.Open(folderPath & fileName)
        With wb.Worksheets(2)
            Set copyRange = .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
        End With
        copyRange.EntireRow.Copy destinationSheet.Cells(lr + 1, "A")
        wb.Close False
        fileName = Dir
    Wend

End Sub

 

[GuyFromStl]

The code appears to have something missing as I get the following error message: Compile Error: Wrong number of arguments or invalid property assignment. After clicking okay it goes to the 5th line item strating with monthname =... it then highlights the word default. I have been unsuccessful at finding why it is doing this.