Solved

Excel VBA to save consolidate multiple workbooks into a specific folder

Posted on 2016-09-01
5
74 Views
Last Modified: 2016-09-20
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"

Open in new window


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

Open in new window

0
Comment
Question by:Shally Steazy
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
5 Comments
 
LVL 26

Accepted Solution

by:
ProfessorJimJam earned 500 total points (awarded by participants)
ID: 41780580
You can add this line to prompt save as to be able to select a location to save

Application.Dialogs(xlDialogSaveAs).Show
1
 

Author Comment

by:Shally Steazy
ID: 41780658
This suits my need. Thanks a lot ProfessorJimJam
0
 
LVL 26

Expert Comment

by:ProfessorJimJam
ID: 41780766
you are welcome shally
0
 
LVL 26

Expert Comment

by:ProfessorJimJam
ID: 41806206
Solution is accepted by OP
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

635 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question