FSOで、ディレクトリ内のBookのSheetを一つのBookにまとめる。

仕事の依頼は突然に…

全く関係ない。全く関係ない業務の方からこんな依頼されました。「このBookのSheetをさぁ～、集計.xlsxにまとめるマクロ作れる？」。正直、かったり～なぁ～、俺の業務じゃないしと思いながらもFSOの復習がてら作ってみました。

目次
　 １　閲覧対象者
　 ２　得られる効果
　 ３　設計
　 ４　コードの解説　
　 ５　感想　

１　閲覧対象者

FSOを使って、たくさんのBookのSheetを1つのBookにまとめたい方。

例↓↓

今回は、集計.xlsxに店舗A～店舗CのBookのSheetをまとめます。前提として店舗Bookには「１Sheet」のみの想定です。）

２　得られる効果

作業がしやすくなる…でしょうか(;^ω^)
正直、Bookが重たくなるので便利かどうかはよくわかりません。

３　設計

１つのディレクトリにある「集計.xlsx」に店舗A～店舗CのBookのSheetをまとめます。

各店舗Bookには以下の様に、売上Sheetが入っています（１Sheetのみ）。

実行前集計.xlsx↓↓

集計に各BookのSheetをまとめる.xlsmのマクロ実行後の集計.xlsx↓↓

店舗A、店舗B、店舗CのSheetが追加されています。

また集計.xlsxのBackUpファイルも取っておきます。

４　コードの解説

集計に各BookのSheetをまとめる.xlsmのコードを見ていきましょう。

Sub すべてのファイルに値を代入()

    'FSOを宣言
    Dim fso As Object: Set fso = CreateObject("scripting.filesystemobject")
    Dim tgt_wb As Workbook
    Dim wbPath
    Dim myfiles, file
    Dim shName
    
    Application.ScreenUpdating = False
    
    'pathの設定
    wbPath = ThisWorkbook.Path
    
    Set tgt_wb = Workbooks.Open(wbPath & "\集計.xlsx")
    
    'BackUp
    If Not fso.FileExists(wbPath & "\bk_集計.xlsx") Then
        ActiveWorkbook.SaveAs Filename:= _
            wbPath & "\bk_集計.xlsx", FileFormat:= _
            xlOpenXMLWorkbook, CreateBackup:=False
        
        ActiveWorkbook.Close
        Set tgt_wb = Workbooks.Open(wbPath & "\集計.xlsx")
    End If
        
    Set myfiles = fso.getfolder(wbPath).Files
    
    For Each file In myfiles
        If Not file.Name Like "~$*" Or file.Name Like ".xlsx" Then
            If Not file.Name Like "*集計*" Then
                Debug.Print fso.getbasename(wbPath & "\" & file.Name)
                shName = fso.getbasename(wbPath & "\" & file.Name)
                Call OpenBooks_String(wbPath & "\" & file.Name)
                
                'sheetのコピー
                ActiveSheet.Name = shName
                Sheets(shName).Copy after:=tgt_wb.Sheets(tgt_wb.Sheets.Count)
                
                Call CloseBooks_Sring(file.Name)
            End If
        End If
    Next
    
    '小計.xlsxを保存して閉じる。
    tgt_wb.Save
    tgt_wb.Close
    
End Sub

サブルーチン１

Sub OpenBooks_String(ByVal mypath As String)
    
    Workbooks.Open mypath

End Sub

サブルーチン２

Sub CloseBooks_Sring(ByVal myName As String)
    
    Dim wb As Workbook
    Set wb = Workbooks(myName)
    
    wb.Close (False) 'True=保存して閉じる。False＝保存しないで閉じる。

End Sub

コードの説明

１　集計.xlsxのBackUpを取ります。すでに、bk_集計.xlsxが存在する場合は処理しません。
２　ファイルの数だけループ処理します。この時の注意点は、ファイル名に集計の文字列が入っている場合は処理ません。処理の対象は店舗Bookとなります。
３　Sheet名ををgetbasenameで取得します（拡張子を除いたファイル名）。集計.xlsxコピーします。
４　Bookを保存せずに閉じて、次のBookを処理する。

以上、１～４の繰り返しとなります。エクセルで使用できるメモリの限りSheetを作成できます（PCのメモリに依存する）。

５　感想

FSOって使わないと忘れるので、今後こういう場面に出くわしたらコピッペで使おうと思います。
いい練習になりました。

ではでは、この辺で(^^)/~~~