Merge Workbooks from Multiple Folders Based on by reading Order Numbers in Excel file

Question

I'm seeking assistance in creating a VBA macro that can help me merge data from multiple workbooks located in different folders based on order numbers in another excel file. I am beginner and not having enough knowledge in VBA. It would be a kind help to achieve my migration activity.

Here's the scenario:

I have four folders: Folder 1, Folder 2, Folder 3, and Folder 4. Folder 1 contains a single Excel workbook with one sheet. Folder 2 contains around 300 data workbooks, each named after an order number. Folder 3 contains a single Excel workbook with one sheet. Folder 4 contains the same number of files as Folder 2, with filenames corresponding to the order numbers. I need to read the workbooks in all the folders and create a new workbook that combines the four excel workbook sheets to one workbook. The final workbook should be renamed based on a Folder 2 file name or I can keep open a separate excel file with list of order numbers to consider for renaming.

Requirements:

Preserve the existing sheet names in the merged workbook. All four worksheets in final workbook should be by sequence based on folder reading.

I would greatly appreciate it if someone could help me with the VBA code to achieve this. Any guidance, suggestions, or sample code would be extremely helpful.

Thank you in advance for your assistance!

Here is the code i am trying but not getting through.

Sub MergeWorkbooks()

    Dim FolderPath1 As String, FolderPath2 As String, FolderPath3 As String, FolderPath4 As String
    Dim OrderNumbersFilePath As String
    Dim OrderNumbersWorkbook As Workbook
    Dim OrderNumbersSheet As Worksheet
    Dim FinalWorkbook As Workbook
    Dim DataWorkbook As Workbook
    Dim OrderNumber As String
    
    ' Set the folder paths for each folder
    FolderPath1 = "Path\to\Folder1\"
    FolderPath2 = "Path\to\Folder2\"
    FolderPath3 = "Path\to\Folder3\"
    FolderPath4 = "Path\to\Folder4\"
    
    ' Set the file path of the workbook containing order numbers
    OrderNumbersFilePath = "C:\OrderNumbersWorkbook.xlsx"
    
    ' Open the workbook containing order numbers
    Set OrderNumbersWorkbook = Workbooks.Open(OrderNumbersFilePath)
    Set OrderNumbersSheet = OrderNumbersWorkbook.Worksheets(1)
    
    ' Create a new workbook for the final result
    Set FinalWorkbook = Workbooks.Add
    
    ' Loop through each order number in the list
    For i = 1 To OrderNumbersSheet.Cells(Rows.Count, 1).End(xlUp).Row
        OrderNumber = OrderNumbersSheet.Cells(i, 1).Value
        
        ' Open the corresponding data workbook from Folder2
        Set DataWorkbook = Workbooks.Open(FolderPath2 & "\" & OrderNumber & ".xlsx")
        
        ' Copy the data from the data workbook to the final workbook
        DataWorkbook.Worksheets(1).Copy After:=FinalWorkbook.Sheets(FinalWorkbook.Sheets.Count)
        FinalWorkbook.Sheets(FinalWorkbook.Sheets.Count).Name = OrderNumber
        
        ' Close the data workbook without saving changes
        DataWorkbook.Close SaveChanges:=False
        
        ' Open the corresponding workbook from Folder4
        Set DataWorkbook = Workbooks.Open(FolderPath4 & "\" & OrderNumber & ".xlsx")
        
        ' Copy the data from the workbook to the final workbook
        DataWorkbook.Worksheets(1).UsedRange.Copy Destination:=FinalWorkbook.Sheets(OrderNumber).Cells(Rows.Count, 1).End(xlUp).Offset(1)
        
        ' Close the workbook without saving changes
        DataWorkbook.Close SaveChanges:=False
    Next i
    
    ' Save and close the final workbook
    FinalWorkbook.SaveAs "C:\to\Output_Workbook.xlsx"
    FinalWorkbook.Close
    
    ' Close the order numbers workbook
    OrderNumbersWorkbook.Close
End Sub

I tried to execute the above code but some how it is not accurately reading the files and preparing the workbook.

Answer 1

To merge workbooks from multiple folders based on order numbers recorded in an Excel file, you can follow these steps:

Set up your folders: Organize the folders containing the workbooks you want to merge. Ensure that each folder contains the necessary Excel files and that the file names correspond to the order numbers mentioned in the Excel file.

Prepare your Excel file: Open the Excel file that contains the order numbers and the corresponding file names. Make sure the order numbers are in one column (let's say column A) and the corresponding file names are in another column (let's say column B). The file names should match the actual names of the Excel files in the respective folders.

Create a new workbook for merging: Open a new workbook where you will consolidate the data from the multiple workbooks.

So, something like this, I think (I didn't test the code).

Sub MergeWorkbooks()
    Dim sourcePath As String
    Dim targetWorkbook As Workbook
    Dim orderNumber As Range
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    
    ' Set the source path to the folder containing the workbooks
    sourcePath = "C:\Your\Source\Folder\"
    
    ' Set the target workbook where you want to consolidate the data
    Set targetWorkbook = ThisWorkbook
    
    ' Loop through the order numbers in column A
    For Each orderNumber In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        fileName = orderNumber.Offset(0, 1).Value ' Get the file name from column B
        
        ' Open the workbook based on the file name
        Set wb = Workbooks.Open(sourcePath & fileName)
        
        ' Copy and paste the desired data from the workbook
        ' Modify this section based on your specific requirements
        For Each ws In wb.Worksheets
            ws.UsedRange.Copy targetWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        Next ws
        
        wb.Close SaveChanges:=False ' Close the opened workbook without saving changes
    Next orderNumber
    
    MsgBox "Workbooks merged successfully!", vbInformation
End Sub

Answer 2

This might be close to what you want to do:

Sub MergeWorkbooks()

    ' Set the folder paths for each folder
    Const FolderPath1 As String = "Path\to\Folder1\"
    Const FolderPath2 As String = "Path\to\Folder2\"
    Const FolderPath3 As String = "Path\to\Folder3\"
    Const FolderPath4 As String = "Path\to\Folder4\"
    Const OrderNumbersFilePath As String = "C:\OrderNumbersWorkbook.xlsx"
    
    Dim wb As Workbook, i As Long
    Dim wbOrders As Workbook, wsOrders As Worksheet, OrderNum As String
    
    ' Open the workbook containing order numbers
    Set wbOrders = Workbooks.Open(OrderNumbersFilePath)
    Set wsOrders = wbOrders.Worksheets(1)
    
    ' Loop through each order number in the list
    For i = 1 To wsOrders.Cells(Rows.Count, 1).End(xlUp).row
        
        OrderNum = wsOrders.Cells(i, 1).Value
        Set wb = Workbooks.Add(xlWBATWorksheet)
        
        CopySheetFromFile FolderPath1 & OrderNum & ".xlsx", wb, 1
        DeleteSheet wb, 2 'remove empty sheet
        CopySheetFromFile FolderPath2 & "file2.xlsx", wb, 2 'fixed file
        CopySheetFromFile FolderPath3 & OrderNum & ".xlsx", wb, 3
        CopySheetFromFile FolderPath2 & "file4.xlsx", wb, 4 'fixed file
        
        wb.SaveAs "C:\to\" & OrderNum & ".xlsx"
        wb.Close
    Next i
    wbOrders.Close
End Sub

'Copy the first sheet from the file at `srcPath` to the specified
'  position `shtPos` in `destWb`
Sub CopySheetFromFile(srcPath As String, destWb As Workbook, shtPos As Long)
    Dim wbSrc As Workbook
    Set wbSrc = Workbooks.Open(Filename:=srcPath, ReadOnly:=True)
    If shtPos = 1 Then
        wbSrc.Worksheets(1).Copy Before:=destWb.Worksheets(1)
    Else
        wbSrc.Worksheets(1).Copy after:=destWb.Worksheets(shtPos - 1)
    End If
    wbSrc.Close
End Sub

'Reove a worksheet without prompting
Sub DeleteSheet(wb As Workbook, shtPos As Long)
    Application.DisplayAlerts = False
    wb.Worksheets(shtPos).Delete
    Application.DisplayAlerts = False
End Sub