合并多个工作簿中的多个工作表答案

【问题标题】：Merge Multiple Worksheets from Multiple Workbooks合并多个工作簿中的多个工作表
【发布时间】：2010-04-21 21:59:51
【问题描述】：

我找到了多篇关于合并数据的帖子，但我仍然遇到了一些问题。我有多个带有多张纸的文件。每个文件中的示例 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

现在它可以找到文件并打开它们并找到正确的工作表，但是当它尝试复制数据时，没有任何内容被复制。

【问题讨论】：

(2) 部分在.Range("B65536").End(xlUp)(2).PasteSpecial 中看起来格格不入

标签： excel vba

【解决方案1】：

而不是这个：

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)

这会将整个工作表复制到您的主工作簿中。

【讨论】：

【解决方案2】：

一种不同的方法，但效果很好：

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) 提供的

【讨论】：