Results 1 to 9 of 9

Consolidate Multiple Workbooks Into One Master

This is a discussion on Consolidate Multiple Workbooks Into One Master within the Excel Questions forums, part of the Question Forums category; I am new to using VB and macros so please forgive me. I have multiple spreadsheets, all with the same ...

  1. #1
    Board Regular bowlinbd's Avatar
    Join Date
    Jul 2008
    Location
    Knoxville, TN
    Posts
    97

    Default Consolidate Multiple Workbooks Into One Master

    I am new to using VB and macros so please forgive me. I have multiple spreadsheets, all with the same columns, that I am trying to combine into one master sheet. The column range is A through J; each workbook may have a different number of rows; all workbooks are using Sheet1.

    I found the below code on CONSOLIDATE DATA FROM ALL FILES IN A FOLDER (SOLUTION). The code works great except that I want to limit the Excel files that are being pulled in. Is there a way to manually put in only the files that I wish to consolidate? Thanks in advance.


    '=========================================================
    '- CONSOLIDATE DATA SHEETS
    '- (ALL WORKBOOKS IN FOLDER.ALL SHEETS)
    '=========================================================
    '- Generic code for transferring data from
    '- all worksheets from all workbooks contained in a folder
    '- to a single sheet.
    '- Change "Sub Transfer_data()" etc. as required.
    '----------------------------------------------------------
    '- Workbooks must be the only ones in the folder.
    '----------------------------------------------------------
    '- worksheets must be contain tables which are
    '- identical to the master, headings in row 1.
    '- *master sheet is remade each time*
    '- run this code from the master sheet (with headings)
    '- by Brian Baulsom (BrianB) January 1st.2004
    '----------------------------------------------------------
    Dim ToBook As String
    Dim ToSheet As Worksheet
    Dim NumColumns As Integer
    Dim ToRow As Long
    Dim FromBook As String
    Dim FromSheet As Worksheet
    Dim FromRow As Long
    Dim LastRow As Long
    '-
    '=========================================================
    '- MAIN ROUTINE
    '=========================================================
    Sub FILES_FROM_FOLDER()
    Application.Calculation = xlCalculationManual
    ChDrive ActiveWorkbook.Path
    ChDir ActiveWorkbook.Path
    ToBook = ActiveWorkbook.Name
    '---------------------------
    '- MASTER SHEET
    '---------------------------
    Set ToSheet = ActiveSheet
    NumColumns = ToSheet.Range("A1").End(xlToRight).Column
    ToRow = ToSheet.Range("A65536").End(xlUp).Row
    '- clear master
    If ToRow <> 1 Then
    ToSheet.Range(ToSheet.Cells(2, 1), _
    ToSheet.Cells(ToRow, NumColumns)).ClearContents
    End If
    ToRow = 2
    '------------------------------------------
    '- main loop to open each file in folder
    '------------------------------------------
    FromBook = Dir("*.xls")
    While FromBook <> ""
    If FromBook <> ToBook Then
    Application.StatusBar = FromBook
    Transfer_data ' subroutine below
    End If
    FromBook = Dir
    Wend
    '-- close
    MsgBox ("Done.")
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
    End Sub
    '
    '==============================================================
    '- CHANGE THIS CODE TO DO WHAT YOU WANT TO THE OPENED WORKBOOK
    '- HERE IT COPIES DATA FROM ALL SHEETS TO THE MASTER SHEET
    '==============================================================
    Private Sub Transfer_data()
    Workbooks.Open FileName:=FromBook
    For Each FromSheet In Workbooks(FromBook).Worksheets
    LastRow = FromSheet.Range("A65536").End(xlUp).Row
    '-----------------------------------------------------
    '- copy/paste to master sheet
    FromSheet.Range(FromSheet.Cells(2, 1), _
    FromSheet.Cells(LastRow, NumColumns)).Copy _
    Destination:=ToSheet.Range("A" & ToRow)
    '-----------------------------------------------------
    '- set next ToRow
    ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
    Next
    Workbooks(FromBook).Close savechanges:=False
    End Sub
    '==== EOP ====================================================

  2. #2
    MrExcel MVP
    Moderator
    Andrew Poulsom's Avatar
    Join Date
    Jul 2002
    Posts
    69,459

    Default Re: Consolidate Multiple Workbooks Into One Master


  3. #3
    Board Regular
    Join Date
    Feb 2006
    Posts
    3,437

    Default Re: Consolidate Multiple Workbooks Into One Master

    Hi
    How do you wish to choose your files? Like all files ending with 2008 or all files beginning from bostonxxxxxxxx or just random?
    Ravi

  4. #4
    Board Regular bowlinbd's Avatar
    Join Date
    Jul 2008
    Location
    Knoxville, TN
    Posts
    97

    Default Re: Consolidate Multiple Workbooks Into One Master

    I'd like a way to manually choose the files which files to consolidate. They're going to have different file names.

  5. #5
    Board Regular
    Join Date
    Feb 2006
    Posts
    3,437

    Default Re: Consolidate Multiple Workbooks Into One Master

    Hi
    Insert the following macro codes into a workbook and save it in the same folder where data to be consolidated is present.
    Code:
    Sub List_files()
    Dim f As String
    Cells(1, 1) = "=cell(""filename"")"
    Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
    Cells(2, 1).Select
    f = Dir(Cells(1, 2) & "*.xls")
    Do While Len(f) > 0
    ActiveCell.Formula = f
    ActiveCell.Offset(1, 0).Select
    f = Dir()
    Loop
    End Sub
    On running this macro, it lists files in the folder. Put an x mark in col B against the files you choose to consolidate.
    Code:
    Sub consolidate()
    Dim x As Long, a As Long
    Dim b As String
    x = Cells(Rows.Count, 1).End(xlUp).Row
    MsgBox "there are " & x - 1 & " files"
    For a = 2 To x
    If Cells(a, 2) = "x" Then
    b = Cells(a, 1)
    Workbooks.Open Filename:=Cells(1, 2) & b
    y = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    Range("A1:J" & y).Copy
    ActiveWorkbook.Close
    z = Cells(Rows.Count, 1).End(xlUp).Row + 2
    Range("A" & z).PasteSpecial
    End If
    Next a
    MsgBox "Listing is complete."
    End Sub
    This will consolidate data from sheet1 of selected files from A to J
    Ravi

  6. #6
    Board Regular bowlinbd's Avatar
    Join Date
    Jul 2008
    Location
    Knoxville, TN
    Posts
    97

    Default Re: Consolidate Multiple Workbooks Into One Master

    I think this may very well work. Thank you for the assistance.

  7. #7
    New Member
    Join Date
    Jul 2008
    Posts
    7

    Default Re: Consolidate Multiple Workbooks Into One Master

    Can I amend this macro in such a way that it will only copy data from one particular sheet (let's say only "Sheet5" out of the 10 sheets in a file)? How should I do this?

  8. #8
    Board Regular
    Join Date
    Feb 2006
    Posts
    3,437

    Default Re: Consolidate Multiple Workbooks Into One Master

    HI
    replace with these codes
    Code:
    y = Worksheets("Sheet5").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Sheet5").Range("A1:J" & y).Copy
    Ravi

  9. #9
    New Member
    Join Date
    Jul 2008
    Posts
    7

    Default Re: Consolidate Multiple Workbooks Into One Master

    Quote Originally Posted by ravishankar View Post
    HI
    replace with these codes
    Code:
    y = Worksheets("Sheet5").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Sheet5").Range("A1:J" & y).Copy
    Ravi
    Thanks, but my apologies: I was referring to the original macro as stated in the opening post... could you please give me guidance on how to amend the original one?

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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


DMCA.com