consolidate multiple from workbooks into one

geordz

New Member
Joined
Apr 13, 2010
Messages
42
Evening all,
I am hoping someone can help please. I have 12 workbooks (one for each month of a year), ie Jan09, Feb09 etc. Within each workbook I have 10 tabs (one for each datalogger), ie dat1, dat2, dat3. In these tabs/worksheets contains one month of data (approximately 100 rows of data recordings).

I have created another workbook which just has the 10 tabs/worksheets (named dat1, dat2,etc) and what I wish to do is run a macro from this 'active workbook' which will open each of the Jan09, Feb09 workbooks and copy the data from each tab in turn to the similarly named tab in the active book, adding it to the next free row. Therfore I'll end up with the single active book which has 10 tabs (dat1, dat2, etc) with the entire years data in it.

hope that makes sense. I would much appreciate the help as I've only made really basic macros before now.

thanks in advance
david
 
Assuming that Row 1 of each worksheet in the source workbooks contains column headers/labels, try...

Code:
Option Explicit
Sub test()
 
    Dim wbDest As Workbook, wbSource As Workbook
    Dim strPath As String
    Dim ws As Worksheet
    Dim i As Integer
 
[COLOR=seagreen]'   Turn off screen updating[/COLOR]
    Application.ScreenUpdating = False
 
[COLOR=seagreen]'   Assign the active workbook to an object variable[/COLOR]
    Set wbDest = ActiveWorkbook
 
[COLOR=seagreen]'   Set the path to the files (change accordingly)[/COLOR]
    strPath = "C:\Users\Domenic\Desktop\"
 
[COLOR=seagreen]'   Loop through each 2009 file (Jan09, Feb09, etc.)[/COLOR]
    For i = 1 To 12
 
[COLOR=seagreen]'       Open the current file and assign it to an object variable[/COLOR]
        Set wbSource = Workbooks.Open(strPath & Format(DateSerial(2009, i, 1), "mmmyy"))
 
[COLOR=seagreen]'       Copy the data from each worksheet to their respective worksheet in the destination workbook[/COLOR]
        For Each ws In wbSource.Worksheets
            With ws.UsedRange
                .Offset(1, 0).Resize(.Rows.Count - 1).Copy _
                    wbDest.Worksheets(ws.Name).Cells(Worksheets(ws.Name).Rows.Count, "A").End(xlUp)(2)
            End With
        Next ws
 
[COLOR=seagreen]'       Close the current file[/COLOR]
        wbSource.Close savechanges:=False
 
    Next i
 
[COLOR=seagreen]'   Turn on screen updating[/COLOR]
    Application.ScreenUpdating = True
 
End Sub
 
Last edited:
Upvote 0
Thank you very for posting an answer, I will try this as soon as I can

much appreciated

Dave
 
Upvote 0
Tried the code out, but the data starts in the 5th row in each sheet (I have a set of criteria I used for filtering in the first 4 rows). So I tried to change the offset(1,0) to offset(5,0) but this has not worked. Is there something I'm missing here.

Also in the (ws.Name) do I need to give the actual sheet name? Or does it run through all sheets that match in both books

thank you for any assistance
dave
 
Upvote 0
Tried the code out, but the data starts in the 5th row in each sheet (I have a set of criteria I used for filtering in the first 4 rows). So I tried to change the offset(1,0) to offset(5,0) but this has not worked. Is there something I'm missing here.

Try the following macro, with the changes and additions in red...

Code:
Option Explicit
Sub test()

    Dim wbDest As Workbook, wbSource As Workbook
    Dim strPath As String
    Dim ws As Worksheet
    Dim i As Integer
    [COLOR=Red]Dim LastRow As Long, LastCol As Integer[/COLOR]
    
[COLOR=SeaGreen]'   Turn off screen updating[/COLOR]
    Application.ScreenUpdating = False

[COLOR=SeaGreen]'   Assign the active workbook to an object variable[/COLOR]
    Set wbDest = ActiveWorkbook

[COLOR=SeaGreen]'   Set the path to the files (change accordingly)[/COLOR]
    strPath = "C:\Users\Domenic\Desktop\"
    
[COLOR=SeaGreen]'   Loop through each 2009 file (Jan09, Feb09, etc.)[/COLOR]
    For i = 1 To 12
    
[COLOR=SeaGreen]'       Open the current file and assign it to an object variable[/COLOR]
        Set wbSource = Workbooks.Open(strPath & Format(DateSerial(2009, i, 1), "mmmyy"))
        
[COLOR=SeaGreen]'       Copy the data from each worksheet to their respective worksheet in the destination workbook[/COLOR]
        For Each ws In wbSource.Worksheets
            With ws.UsedRange
                [COLOR=Red]LastRow = .Rows.Count + Rows(1).Row - 1
                LastCol = .Columns.Count + Columns(1).Column - 1
                .Range(.Cells(5, 1), .Cells(LastRow, LastCol)).Copy _[/COLOR]
                    wbDest.Worksheets(ws.Name).Cells(Worksheets(ws.Name).Rows.Count, "A").End(xlUp)(2)
            End With
        Next ws
        
[COLOR=SeaGreen]'       Close the current file[/COLOR]
        wbSource.Close savechanges:=False
        
    Next i
    
[COLOR=SeaGreen]'   Turn on screen updating[/COLOR]
    Application.ScreenUpdating = True
    
End Sub
Also in the (ws.Name) do I need to give the actual sheet name? Or does it run through all sheets that match in both books
No, 'ws' is a worksheet variable. So there's no need to make any changes...
 
Upvote 0
Very nice code Domenic, very nice. However, the code is very restrictive about the file name of the source workbooks.
Can this code be modified to simply use whatever workbooks it finds in the source path folder ?

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

Any help is appreciated.. thanks
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top