+ Reply to Thread
Results 1 to 2 of 2

Merging Data from Multiple Workbooks into a Summary Workbook in Excel

  1. #1
    Registered User
    Join Date
    03-24-2015
    Location
    Berlin
    MS-Off Ver
    2013
    Posts
    1

    Merging Data from Multiple Workbooks into a Summary Workbook in Excel

    Hi guys,

    I am a real VBA newbie and I want to do the following: in a folder I have plenty of excel files and all have the same structure. I want to consolidate the data now in a separate workbook. With the help of this site: https://msdn.microsoft.com/en-us/lib...ffice.12).aspx I almost got what I wanted: It is already going through the files and copying the data from the files.

    But I still have two problems and it would be great if you could help me with that:

    1. The makro so far always creates a new workbook with the data. What I want is a "consolidation" workbook, where I push a button and the makro fills in the data in this current workbook in sheet xx.
    2. Based on that the destination range should start at C14.

    Your help is very much appreciated.

    Here is the code so far:

    Sub Consolidation()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long

    ' Change this to the path\folder location of your files.
    MyPath = Cells(4, 3)

    ' Add a slash at the end of the path if needed.
    If Right(MyPath, 1) <> "\" Then
    MyPath = MyPath & "\"
    End If

    ' If there are no Excel files in the folder, exit.
    FilesInPath = Dir(MyPath & "*.xlsx*")
    If FilesInPath = "" Then
    MsgBox "No files found"
    Exit Sub
    End If

    ' Fill the myFiles array with the list of Excel files
    ' in the search folder.
    FNum = 0
    Do While FilesInPath <> ""
    FNum = FNum + 1
    ReDim Preserve MyFiles(1 To FNum)
    MyFiles(FNum) = FilesInPath
    FilesInPath = Dir()
    Loop

    ' Set various application properties.
    With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    ' Add a new workbook with one sheet.
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    rnum = 1

    ' Loop through all files in the myFiles array.
    If FNum > 0 Then
    For FNum = LBound(MyFiles) To UBound(MyFiles)
    Set mybook = Nothing
    On Error Resume Next
    Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
    On Error GoTo 0

    If Not mybook Is Nothing Then
    On Error Resume Next

    ' Change this range to fit your own needs.
    With mybook.Worksheets("Output")
    Set sourceRange = .Range("B4:X4")
    End With

    If Err.Number > 0 Then
    Err.Clear
    Set sourceRange = Nothing
    Else
    ' If source range uses all columns then
    ' skip this file.
    If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
    Set sourceRange = Nothing
    End If
    End If
    On Error GoTo 0

    If Not sourceRange Is Nothing Then

    SourceRcount = sourceRange.Rows.Count

    If rnum + SourceRcount >= BaseWks.Rows.Count Then
    MsgBox "There are not enough rows in the target worksheet."
    BaseWks.Columns.AutoFit
    mybook.Close savechanges:=False
    GoTo ExitTheSub
    Else

    ' Copy the file name in column A.
    ' With sourceRange
    ' BaseWks.Cells(rnum, "A"). _
    ' Resize(.Rows.Count).Value = MyFiles(FNum)
    'End With

    ' Set the destination range.
    Set destrange = BaseWks.Range("A" & rnum)

    ' Copy the values from the source range
    ' to the destination range.
    With sourceRange
    Set destrange = destrange. _
    Resize(.Rows.Count, .Columns.Count)
    End With
    destrange.Value = sourceRange.Value

    rnum = rnum + SourceRcount
    End If
    End If
    mybook.Close savechanges:=False
    End If

    Next FNum
    BaseWks.Columns.AutoFit
    End If

    ExitTheSub:
    ' Restore the application properties.
    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = CalcMode
    End With
    End Sub

  2. #2
    Forum Expert Alf's Avatar
    Join Date
    03-13-2004
    Location
    Gothenburg/Mullsjoe, Sweden
    MS-Off Ver
    Excel 2019 and not sure I like it
    Posts
    4,758

    Re: Merging Data from Multiple Workbooks into a Summary Workbook in Excel

    Perhaps a macro like this could be of help?

    You must change the sPath to suit your needs i.e. the disk and the folder where the files are stored. Don't forget the final "\" in the sPath, macro will not work if this is missing. Also the sFile command
    must be set to capture the right files. Pressent setting will only find "xlsx" files, "xls" will only find "xls" files and "xl*" will find "xls", "xlsb", "xlsx", "xlsm" and "xltm"

    fills in the data in this current workbook in sheet xx.
    For this I would suggest the the workbook from where you run the code (macro will know this as "ThisWorkbook" whatever name you give it) from the sheet where you wisk to imoprt the result.

    Please Login or Register  to view this content.
    Alf

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. merging data from multiple non-standardized workbooks into one summary worksheet
    By mikebolton in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 06-13-2014, 03:16 PM
  2. Replies: 0
    Last Post: 07-29-2013, 03:00 AM
  3. Produce summary workbook sheet with data from multiple workbooks
    By Seancsn in forum Excel - New Users/Basics
    Replies: 3
    Last Post: 03-27-2013, 01:04 PM
  4. [SOLVED] Merging Data from Multiple Workbooks into 1 Workbook (Inc Subfolders)
    By CMR_Steve in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 11-02-2012, 08:51 AM
  5. Importing data from multiple workbooks into a summary workbook
    By Joaniee in forum Excel - New Users/Basics
    Replies: 6
    Last Post: 04-01-2008, 10:04 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1