適材適所

PowerShellやVBAなどプログラミング系の話多めで

【Excel VBA】フォルダ内のExcelシートを1つのブックにまとめる

支店ごとにExcelが提出されてきて、

そのシートを1つのブックにまとめる作業が毎月ある・・・

なんてときや、

月ごとにブックが分かれている1年分を1つのブックにまとめたい・・・

こんなの手作業でやってられっかーー!!

と思っているそこのあなた。

簡単にできるよ。

そう。VBAならね。

ということでそんな多数のブックからシートを集めたいときに

役に立つExcel VBAのコードの紹介です。

どんな動きをするコード?

まとめたいブックが入ったフォルダを指定すれば、

その中のExcelブックからすべてのシートをコピーしてきます。

まとめたいフォルダ f:id:shinmai_papa:20210416215131p:plain

コードを起動 f:id:shinmai_papa:20210416214516p:plain

まとめたいフォルダを指定する f:id:shinmai_papa:20210416214834p:plain

↓ シートがまとめられた!

しかも親切にファイル名をつけている!

(ファイル名をつけたのは、シート名の衝突をできるだけ減らすためです。)

f:id:shinmai_papa:20210416215044p:plain

こんな感じになります。

コード

FileSystemObjectを使います。

Microsoft Scriptin Runtimeを参照設定するか、

CreateObjectを使うかはお好みです。

状況に応じてコメントアウトしてください。

 
'ダイアログで指定されたフォルダ内のExcelシートを実行ブックに
'まとめるプログラム
Sub collectSheet()
    Dim thisBook As Workbook: Set thisBook = ThisWorkbook
    Dim fd As FileDialog
    Dim folderName As String
    '対象のフォルダを選択
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    If fd.Show = False Then
        Exit Sub
    End If
    'フォルダパスを格納
    folderName = fd.SelectedItems(1)
    
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    'Dim fso As FileSystemObject: Set fso = New FileSystemObject
    Dim f as Object
    'Dim f As file
    Application.ScreenUpdating = False
    'フォルダ内を検索する
    For Each f In fso.GetFolder(folderName).Files
        'Excelかどうか、自身と同じファイル名でないか、
        '一時ファイル(~$)ではないかのチェック
        If fso.GetExtensionName(f.Path) Like "xls*" And _
           f.Name <> thisBook.Name And _
           Left(f.Name, 2) <> "~$" Then
            Dim baseName As String: baseName = fso.GetBaseName(f.Path)
            Dim book As Workbook: Set book = Workbooks.Open(f.Path, , True)
            Dim sh As Worksheet
            'ワークシートを集める
            For Each sh In book.Worksheets
                With thisBook
                    sh.Copy after:=.Worksheets(.Worksheets.Count)
                  'シート名は最大で31文字の制限があるのでLeft関数を使う
       '新しいシート名はブック名.シート名とする
                    ActiveSheet.Name = Left(baseName & "." & sh.Name, 31)
                End With
            Next sh
            book.Close False
        End If
    Next f
    Application.ScreenUpdating = True
End Sub

解説になっていない解説

仕組みは単純です。

FileSystemObjectの機能でフォルダ内のxlsという文字を

含むファイルをかたっぱしから開いて

シートをかたっぱしからmoveするだけです。

Application.ScreenUpdating = Falseにしているので

開いているところが見えないだけです。

陰でこそこそやってます。

注意点

調子に乗って大量のシートをまとめてしまうと、

想像以上にブックが重くなってしまうことがあります。

ブックの使い勝手が悪くなってしまっては本末転倒です。

対象のブックをフォルダで分けるなど、

大量のシートが集まり過ぎないように注意してくださいね。

終わりに

年度末、月末などにこう言った作業に追われる方も多いのでは・・・?

手作業で実行していると時間ばっかりかかってしまうので

VBAで楽できるところは楽してください!!

Excelは便利ですから!

ExcelにできることはExcelにやらせてくださいね!

というわけでここまでお読みいただき、ありがとうございました。

VBAを使ってExcelをどうのこうのする関連記事

www.tekizai.net

www.tekizai.net

www.tekizai.net

www.tekizai.net