複数のエクセルシートを一つに合算したい。

Question

各部署より提出される残業時間のエクセルシートを一つに合算したい。

残業フォルダの中に、
残業＿部署A.xlsx
残業＿部署B.xlsx
残業＿部署C.xlsx
・
・
・
複数のエクセルファイルがあります。（エクセルファイル数は変動）

エクセルファイルの中に、
1,2,3の3つのシートがあります。
内容は、すべて一緒です。

シートの内容は、15名ずつ残業時間が記入できるようになっています。
15名まではシート1へ
16名～30名まではシート2へ
31名～45名まではシート3へ
記入する為、部署ごとに仕様するシートの枚数は異なります。

残業フォルダの中に、
残業時間合算というエクセルを作成し、
各部署の残業エクセルシートを一つのエクセルへ合算したいです。
残業データが入っている箇所は、D31：AM45の範囲です。

Comments

[1T2R3M4]

現時点のコードをmarkdownで追記してください。

[t_obara]

もう少し、できないことを具体的に落とし込むと良いと思いますよ。やりたいことの仕様を提示することも必要かと思いますが、その仕様の中でどの部分の実装ができないのか、といった視点で質問されると良いのではないかと。

[K_3578]

現状の内容だと質問者の仕事を代わりにやってくれという内容にしか取れないですね

Answer 1

Sub Sample()
    
    Const folderPath = "C:\残業フォルダ\"
    Const fileName = "残業＿*.xlsx"
    Const rngAddr = "D31:AM45"
    
    Dim dic 'As Scripting.Dictionary
    Dim fso 'As Scripting.FileSystemObject
    
    Set dic = CreateObject("Scripting.Dictionary")
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    With fso
        Application.ScreenUpdating = False
        Dim f 'As File
        For Each f In fso.GetFolder(folderPath).Files
            If f.Name Like fileName Then
                With Workbooks.Open(f.Path)
                    Dim ws As Worksheet
                    For Each ws In .Worksheets
                        dic.Add f.Path & vbTab & ws.Name, ws.Range(rngAddr).Value
                    Next
                    .Close False
                End With
            End If
        Next
        Application.ScreenUpdating = True
    End With
    
    Set ws = Workbooks.Add.Worksheets(1)
    Dim k, v, r, c, o
    For Each k In dic
        v = dic(k)
        r = UBound(v, 1)
        c = UBound(v, 2)
        ws.Cells.Resize(r, c).Offset(o, 0).Value = v
        ws.Cells.Resize(1, 2).Offset(o, c).Value = Split(k, vbTab)
        o = o + r
    Next
    ws.UsedRange.EntireColumn.AutoFit
End Sub