[英]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.
示例每个文件中的示例2007-01.xls ... 2007-12.xls是标记为01、02、03 .....的工作表上的每日数据。文件中还有其他工作表,所以我不能循环浏览所有工作表。 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 我已经为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. 现在,它可以找到文件并打开它们并进入正确的工作表,但是当它尝试复制数据时,没有任何内容被复制。
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 ) 这是由SNB提供的( http://www.ozgrid.com/forum/member.php?u=61472 )
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.