Объединить несколько рабочих листов из нескольких рабочих книг

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

Другой подход, но прекрасно работает:

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)

Answer 2

Вместо этого:

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)

Это скопирует весь лист в вашу основную рабочую книгу.