Needing some VBA help ( Sub Consolidate() )

[danzon]

A while back, someone on these boards pointed me to this script ( https://sites.google.com/a/madrocke.../merge-functions/consolidate-wbs-to-one-sheet ) which has really served my purposes well.

It takes the first sheet of all workbooks within a folder and and copies all rows into my master and stacks the rows one over the other. Perfect. Basically consolidating all data into one master sheet for me.

Now I want to take that to the next step.

My "Master" now has 12 tabs.. JAN, FEB, MAR etc etc

My 20 to 30 or so source workbooks each also have the same 12 tabs.

I want to consolidate the JAN tab of each source workbook into my "Master" JAN..... same for FEB into my MASTER FEB.. and so on.

So keep functionality almost exactly as is but consolidate EACH tab to the corresponding MASTER tab, all 12 tabs to consolidate with 1 click of the macro


Can anyone help with tweaking the existing code ? Thanks in advance, much appreciate !

[FONT=courier new]Option Explicit

Sub Consolidate()
[B]'Author:     Jerry Beaucaire'
'Date:       9/15/2009     (2007 compatible)  (updated 4/29/2011)
'Summary:    Merge files in a specific folder into one master sheet (stacked)
'            Moves imported files into another folder
[/B]
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet

[B]'Setup</STRONG>
    Application.ScreenUpdating = False  [B]'speed up macro execution</STRONG>
    Application.EnableEvents = False    [B]'turn off other macros for now</STRONG>
    Application.DisplayAlerts = False   [B]'turn off system messages for now</STRONG>
    
    Set wsMaster = ThisWorkbook.Sheets("[B]Master</STRONG>")    [B]'sheet report is built into</STRONG>

With wsMaster
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        .UsedRange.Offset(1).EntireRow.Clear
        NR = 2
    Else
        NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    [B]'appends data to existing data</STRONG>
    End If

[B]'Path and filename (edit this section to suit)</STRONG>
    fPath = "[B]C:\2011\Files\</STRONG>"            [B]'remember final \ in this string</STRONG>
    fPathDone = fPath & "Imported\"     [B]'remember final \ in this string</STRONG>
    On Error Resume Next
        MkDir fPathDone                 [B]'creates the completed folder if missing</STRONG>
    On Error GoTo 0
    fName = Dir(fPath & "[B]*.xls*</STRONG>")        [B]'listing of desired files, edit filter as desired</STRONG>
[B]
'Import a sheet from found files</STRONG>
    Do While Len(fName) > 0
        If fName <> ThisWorkbook.Name Then              [B]'don't reopen this file accidentally</STRONG>
            Set wbData = Workbooks.Open(fPath & fName)  [B]'Open file</STRONG>

[B]        'This is the section to customize, replace with your own action code as needed
</STRONG>            LR = Range("A" & Rows.Count).End(xlUp).Row  [B]'Find last row</STRONG>
            Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
            wbData.Close False                                [B]'close file</STRONG>
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1  [B]'Next row</STRONG>
            Name fPath & fName As fPathDone & fName           [B]'move file to IMPORTED folder</STRONG>
        End If
[/FONT][FONT=courier new]        fName = Dir                                       [B]'ready next filename</STRONG>
[/FONT][FONT=courier new]    Loop
End With

ErrorExit:    [B]'Cleanup</STRONG>
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True         [B]'turn system alerts back on</STRONG>
    Application.EnableEvents = True          [B]'turn other macros back on</STRONG>
    Application.ScreenUpdating = True        [B]'refreshes the screen</STRONG>
End Sub
[/FONT]




[/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B][/B]

</STRONG>

 

[Rosen]

The following code assumes the tab names are the same between the Master and the Source sheets, if this is not true, it will need to be tweeked.

Option Explicit
Sub Consolidate()
'Author:     Jerry Beaucaire'
'Date:       9/15/2009     (2007 compatible)  (updated 4/29/2011)
'Summary:    Merge files in a specific folder into one master sheet (stacked)
'            Moves imported files into another folder
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR() As Long, n As Long, bClear() As Boolean
Dim wbData As Workbook, wsMaster As Workbook
Dim wsCurrMaster As Worksheet, wsCurrSource As Worksheet
'Setup
    Application.ScreenUpdating = False  'speed up macro execution
    Application.EnableEvents = False    'turn off other macros for now
    Application.DisplayAlerts = False   'turn off system messages for now
    
    Set wsMaster = ThisWorkbook '.Sheets("Master")    'sheet report is built into
With wsMaster
    ReDim NR(1 To .Sheets.Count) As Long
    ReDim bClear(1 To .Sheets.Count) As Boolean
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        For Each wsCurrMaster In .Sheets
            wsCurrMaster.UsedRange.Offset(1).EntireRow.Clear
            n = n + 1
            bClear(n) = True
        Next wsCurrMaster
        'NR = 2
    Else
        'NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
    End If
    
'Path and filename (edit this section to suit)
    fPath = "C:\2011\Files\"            'remember final \ in this string
    fPathDone = fPath & "Imported\"     'remember final \ in this string
    On Error Resume Next
        MkDir fPathDone                 'creates the completed folder if missing
    On Error GoTo 0
    fName = Dir(fPath & "*.xls*")        'listing of desired files, edit filter as desired
'Import a sheet from found files
    Do While Len(fName) > 0
        If fName <> ThisWorkbook.Name Then              'don't reopen this file accidentally
            Set wbData = Workbooks.Open(fPath & fName)  'Open file
            For n = 1 To .Sheets.Count Step 1
                Set wsCurrMaster = .Sheets(n)
                NR(n) = wsCurrMaster.Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
                If bClear(n) Then
                    NR(n) = 2
                    bClear(n) = False
                End If
        'This is the section to customize, replace with your own action code as needed
                LR = wbData.Sheets(wsCurrMaster.Name).Range("A" & Rows.Count).End(xlUp).Row  'Find last row
                wbData.Sheets(wsCurrMaster.Name).Range("A1:A" & LR).EntireRow.Copy wsCurrMaster.Range("A" & NR(n))
                wbData.Close False                                'close file
                NR(n) = .Range("A" & .Rows.Count).End(xlUp).Row + 1  'Next row
            Next n
            Name fPath & fName As fPathDone & fName           'move file to IMPORTED folder
        End If
        fName = Dir                                       'ready next filename
    Loop
End With
ErrorExit:    'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
End Sub

The code has not been tested so make sure you have backed up your data before you run the code.

Hope this helps!

 

[danzon]

Thanks for the help Rosen,

tab names are the same between Master and the source workbooks... not sure if it is relevant but data in each tab of each workbook starts in row 4.


Tab names in master and in source workbooks are
(sample)(Jan)(Feb)(Mar)(apr)(May)(Jun)(Jul) and so on till (Dec)

The code is opening the first source workbook but then unfortunately fails at this line with an error

NR(n) = wsCurrMaster.Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data

Here is the entirety of exactly what I am using

Sub Consolidate()
'Author:     Jerry Beaucaire'
'Date:       9/15/2009     (2007 compatible)  (updated 4/29/2011)
'Summary:    Merge files in a specific folder into one master sheet (stacked)
'            Moves imported files into another folder
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR() As Long, n As Long, bClear() As Boolean
Dim wbData As Workbook, wsMaster As Workbook
Dim wsCurrMaster As Worksheet, wsCurrSource As Worksheet
'Setup
    Application.ScreenUpdating = False  'speed up macro execution
    Application.EnableEvents = False    'turn off other macros for now
    Application.DisplayAlerts = False   'turn off system messages for now
    
    Set wsMaster = ThisWorkbook '.Sheets("sample")    'sheet report is built into
With wsMaster
    ReDim NR(1 To .Sheets.Count) As Long
    ReDim bClear(1 To .Sheets.Count) As Boolean
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        For Each wsCurrMaster In .Sheets
            wsCurrMaster.UsedRange.Offset(1).EntireRow.Clear
            n = n + 1
            bClear(n) = True
        Next wsCurrMaster
        'NR = 2
    Else
        'NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
    End If
    
'Path and filename (edit this section to suit)
    fPath = "C:\Documents and Settings\danzon\Desktop\Copy of Brittany\files\"            'remember final \ in this string
    fPathDone = fPath & "Imported\"     'remember final \ in this string
    On Error Resume Next
        MkDir fPathDone                 'creates the completed folder if missing
    On Error GoTo 0
    fName = Dir(fPath & "*.xls*")        'listing of desired files, edit filter as desired
'Import a sheet from found files
    Do While Len(fName) > 0
        If fName <> ThisWorkbook.Name Then              'don't reopen this file accidentally
            Set wbData = Workbooks.Open(fPath & fName)  'Open file
            For n = 1 To .Sheets.Count Step 1
                Set wsCurrMaster = .Sheets(n)
                NR(n) = wsCurrMaster.Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
                If bClear(n) Then
                    NR(n) = 2
                    bClear(n) = False
                End If
        'This is the section to customize, replace with your own action code as needed
                LR = wbData.Sheets(wsCurrMaster.Name).Range("A" & Rows.Count).End(xlUp).Row  'Find last row
                wbData.Sheets(wsCurrMaster.Name).Range("A1:A" & LR).EntireRow.Copy wsCurrMaster.Range("A" & NR(n))
                wbData.Close False                                'close file
                NR(n) = .Range("A" & .Rows.Count).End(xlUp).Row + 1  'Next row
            Next n
            Name fPath & fName As fPathDone & fName           'move file to IMPORTED folder
        End If
        fName = Dir                                       'ready next filename
    Loop
End With
ErrorExit:    'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
End Sub

 

[danzon]

not to detour you Rosen,

but this very nice code from Domenic would also work for my application but the code is very restrictive about the file name of the source workbooks.

>>
http://www.mrexcel.com/forum/excel-questions/472151-consolidate-multiple-workbooks-into-one.html


Can his code be modified to simply use whatever workbooks it finds in the source path ?

My files come from a number of field reps... it will not always be 12 files.. sometimes 10, sometimes as many as 20, and the file names will have various filenames like "andy.xlsx", "northeast region.xlsx", "walmart.xlsx".. etc


Thanks again