Question

我在合并数据时发现了多个帖子，但我仍遇到一些问题。我有多个包含多个工作表的文件。示例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

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

Answer 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)

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

Answer 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

这是由SNB（http://www.ozgrid.com/forum/member.php?u=61472）

提供的

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

2 个答案: