合并来自多个工作簿的多个工作表

我发现有多个关于合并数据的文章，但我仍遇到一些问题。我有多个工作表的多个文件。示例2007-01.xls ... 2007-12.xls在每个这些文件中都是标记为01,02,03的表格上的每日数据......文件中还有其他表格，因此我无法循环所有工作表。我需要将日常数据合并到月度数据中，然后将所有月度数据点合并到年度中。合并来自多个工作簿的多个工作表

在每月的数据我需要它被添加到页面的底部。

我已经添加了文件打开修改为Excel 2007

这是我到目前为止有：

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

现在它可以找到文件，并打开它们，并获得了正确的工作表但是当它试图复制数据时，不会复制任何内容。

来源

2010-04-21 Droter

的'（2）'部分看起来格格不入'.Range（ “B65536”）。端（xlUp）（2）.PasteSpecial' – barrowc 2010-04-22 06:01:12

取而代之的是：

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

你试过

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

这将整个工作表复制到你的主簿。

来源

2010-04-21 22:19:11 Thomas

一种不同的方法，但伟大工程：

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

这是瑞士央行（http://www.ozgrid.com/forum/member.php?u=61472）提供

来源

2010-04-22 17:41:13 Droter

合并来自多个工作簿的多个工作表

回答

相关问题