Merge Multple Worksheets From Multple Workbooks

Question

Hi,

I have found multiple posts on merging data but I am still running into some problems. I have multiple files with multiple sheets. Example 2007-01.xls...2007-12.xls in each of these files are daily data on sheets labeled 01, 02, 03 ..... There are other sheets in the file so I can't just loop through all worksheets. I need to combine the daily data into monthly data, then all of the monthly data points into yearly.

On the monthly data I need it to be added to the bottom of the page.

I have added the file open changes for Excel 2007

Here is what I have so far:

Sub RunCodeOnAllXLSFiles() 
Dim lCount As Long 
Dim wbResults As Workbook 
Dim wbMaster As Workbook 

Application. ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.EnableEvents = False 

On  Error Resume Next 

Set wbMaster =  ThisWorkbook 


Dim oWbk As Workbook 
Dim sFil As String 
Dim sPath As String 

sPath = "C:\Users\test\" 'location of files
ChDir sPath 
sFil = Dir("*.xls") 'change or add  formats
Do While sFil <> "" 'will start LOOP until all files in folder sPath have been looped through Set oWbk = Workbooks.Open(sPath & "\" & sFil) 'opens the file

    Set oWbk = Workbooks.Open(sPath & "\" & sFil) 

    Sheets("01").Select ' HARD CODED FIRST DAY
     Range("B6:F101").Select 'AREA I NEED TO COPY
    Range("B6:F101").Copy 

    wbMaster.Activate 
    Workbooks("wbMaster").ActiveSheet.Range("B65536").End(xlUp)(2).PasteSpecial Paste:=xlValues 
    Application.CutCopyMode = False 

    oWbk.Close True 'close the workbook,  saving changes
    sFil = Dir 
Loop ' End of LOOP

On Error Goto 0 
Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
Application.EnableEvents = True 
End Sub 

Right now it can find the files and open them up and get to the right worksheet but when it tries to copy the data nothing is copied over.

Thanks for your help,

Matt

Answer 1

Instead of this:

Sheets("01").Select ' HARD CODED FIRST DAY
Range("B6:F101").Select 'AREA I NEED TO COPY
Range("B6:F101").Copy 

Have you tried

oWbk.Sheets("01").Copy Before wbMaster.Sheets(1)

That will copy the entire sheet into your master workbook.

Answer 2

A different approach but works great:

Sub RunCodeOnAllXLSFiles()
    Application.ScreenUpdating = False

    c0 = "C:\Users\test\"
    c2 = Dir("C:\Users\test\*.xls")
    Do Until c2 = ""
        With Workbooks.Add(c0 & "\" & c2)
            For Each sh In .Sheets
                If Val(sh.Name) >= 1 And Val(sh.Name) <= 31 Then
                ThisWorkbook.Sheets(1).Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(96, 5) = sh.Range("B6:F101").Value
                End If
            Next
            .Close False
        End With
        c2 = Dir
     Loop

    Application.ScreenUpdating = True
End Sub

This was provided by SNB (http://www.ozgrid.com/forum/member.php?u=61472)