Merge Multiple Worksheets from Multiple Workbooks
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("B开发者_开发知识库65536").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.
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.
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)
精彩评论