troubleshooting Question

Excel VBA to save consolidate multiple workbooks into a specific folder

Avatar of Shally Steazy
Shally SteazyFlag for United States of America asked on
VBAMicrosoft Excel
4 Comments1 Solution323 ViewsLast Modified:
Experts,
Please, I'll like to save this working solution for consolidating multiple excel workbooks into a specific folder. I've added this to my module but it won't work. Please, can I get a standard way for me to choose the folder I want to save the consolidated file into. Thank you

Original code  writer: @ProfessorJimJam

 ' Save the consolidated workbook
    ActiveWorkbook.SaveAs FileName:="C:\Users\shallysteazy\Documents\ConsolidatedWorkbook.xlsx"

Sub MergeTest()

    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long
    Dim FileName As String
    Dim NFile As Long
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    Dim LastRow As Long

    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

    ' Open the file dialog box and filter on Excel files, allowing multiple files
    ' to be selected.
    SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)

    ' NRow keeps track of where to insert new rows in the destination workbook.
    NRow = 1

    ' Loop through the list of returned file names
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        ' Set FileName to be the current workbook file name to open.
        FileName = SelectedFiles(NFile)

        ' Open the current workbook.
        Set WorkBk = Workbooks.Open(FileName)

        ' Get row number of last used row
        LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
                                                  After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
                                                  SearchDirection:=xlPrevious, _
                                                  LookIn:=xlFormulas, _
                                                  SearchOrder:=xlByRows).Row

        ' Set the cell in column N to be the file name.
        SummarySheet.Range("N" & NRow).Value = FileName
        
        ' Create header row
        Set SourceRange = WorkBk.Worksheets(1).Range("A1:O1")
        Set DestRange = SummarySheet.Range("A1:O1")
        DestRange.Value = SourceRange.Value

        ' Set the source range to be B1 through O?.
        ' Modify this range for your workbooks. It can span multiple rows.
        Set SourceRange = WorkBk.Worksheets(1).Range("A2:O" & LastRow)

        ' Set the destination range to start at column A and be the same size as the source range.
        Set DestRange = SummarySheet.Range("A" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)

        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value

        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count

        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
    Next NFile

    ' Call AutoFit on the destination sheet so that all data is readable.
    SummarySheet.Columns.AutoFit
    
    ' Save the consolidated workbook
    ActiveWorkbook.SaveAs FileName:="C:\Users\shallysteazy\Documents\ConsolidatedWorkbook.xlsx"
End Sub
ASKER CERTIFIED SOLUTION
Professor JSpreadsheets Expert

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Top Expert 2014

The Distinguished Expert awards are presented to the top veteran and rookie experts to earn the most points in the top 50 topics.

Join our community to see this answer!
Unlock 1 Answer and 4 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 4 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros