'同ー形式シートを持つ複数ブックを集計するサンプルマクロ

'D:\Work\Book*.xlsのファイルの、すべてのワークシートを
'アクティブブックのSheet1に加算貼り付けする例です。

'複数範囲の指定が可能になっていますが、性能を良くするためには、
'できるだけ1つの範囲を指定するようにします。

Option Explicit

Sub MyBookSum()
    Dim sPath As String
    Dim sFileFilter As String
    Dim sAddress As String
    Dim sFileName As String
    Dim oSheet_Output As Worksheet
    Dim oRange_Output As Range
    Dim oAreas_Output As Areas
    Dim oBook As Workbook, oSheet As Worksheet
    Dim i As Long
    Dim r As Range

    '対象ファイルと集計結果範囲に関する設定
    sPath = "D:\Work\"
    sFileFilter = "Book*.xls"
    Set oSheet_Output = ActiveWorkbook.Sheets("Sheet1")
    sAddress = "A1:AX200,AY1:AY100"

    'ステータスバーの初期化
    Application.StatusBar = False

    '集計結果範囲の取得
    Set oRange_Output = oSheet_Output.Range(sAddress)

    '集計結果範囲のクリア
    If MsgBox("集計結果の出力範囲をクリアします。よろしいですか?", _
        vbOKCancel Or vbExclamation, "複数ブックの集計") <> vbOK Then Exit Sub
    oRange_Output.ClearContents

    '集計結果範囲のAreasオブジェクトを取得
    Set oAreas_Output = oRange_Output.Areas

    Application.ScreenUpdating = False

    'ファイル名を取得
    sFileName = Dir$(sPath & sFileFilter)

    Do While sFileName <> ""

        Application.StatusBar = "処理中です... " & sFileName

        'ファイルを開く
        Set oBook = Workbooks.Open(sPath & sFileName)

        '集計結果範囲へ加算貼り付け
        For Each oSheet In oBook.Worksheets
            i = 1
            For Each r In oSheet.Range(sAddress).Areas
                r.Copy
                oAreas_Output(i).PasteSpecial xlValues, xlAdd
                i = i + 1
            Next
        Next

        'ファイルを閉じる
        Application.CutCopyMode = False
        oBook.Close False

        '次のファイル名を取得
        sFileName = Dir$()
    Loop

    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub