合併來自多個工作簿的多個工作表

我發現有多個關於合併數據的文章，但我仍遇到一些問題。我有多個工作表的多個文件。示例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

合併來自多個工作簿的多個工作表

回答

相關問題