*

【Excel】複数のエクセル(ブック)のシートを一つのブックに結合するVBA

複数のエクセルのシートを一つのエクセルにまとめるVBAを作ってみた。

ソースコードは使い方の下

使い方

1.まとめたいエクセルを一つのフォルダへ集める

「*.xls*」で検索するので、エクセルファイル以外のファイルがあっても問題なし。

複数のエクセルのシートを結合する 手順1

2.VBAの実行

3.対象フォルダの選択

複数のエクセルのシートを結合する 手順2 フォルダ選択

4.選択した対象フォルダ内に「【結合】エクセル.xlsx」が作成される

複数のエクセルのシートを結合する 手順3 結果出力

「【結合】エクセル.xlsx」に「結合元エクセル名.シート名」として、各シートができる。

ソースコード

Option Explicit
'#############################################################################
' Main
'#############################################################################
Sub Main()

    '画面表示OFF
    Application.ScreenUpdating = False

    '-------------------------------------------
    ' 変数定義
    '-------------------------------------------
    Const cnsDIR = "\*.xls*"                '対象フォルダ内エクセルファイル検索用
    Dim FilePath As String                  'ファイルパス
    Dim strFileName As String               '結合元ファイル名
    
    Dim i As Integer                        'ループ用
    
    'シート結合エクセル用オブジェクト
    Dim App As Excel.Application
    Dim Book As Workbook
    Dim Sheet As Worksheet
    'シート結合エクセル保存名
    Dim BookName As String
    
    '結合元エクセル用
    Dim Book2 As Workbook
    Dim Sheet2 As Worksheet
    
    '-------------------------------------------
    ' シート結合後のファイル名の指定
    '-------------------------------------------
    BookName = "【結合】エクセル.xlsx"
    
    '-------------------------------------------
    ' 結合元のフォルダ選択
    '-------------------------------------------
    FilePath = FolderSelect()
    
    'キャンセル時
    If FilePath = "" Then
        MsgBox "処理キャンセル"
        End
    End If
    
    '-------------------------------------------
    ' 結合先ワークブック作成
    '-------------------------------------------
    'オブジェクトセット
    Set App = CreateObject("Excel.Application")
    '非表示
    App.Visible = False
    'エクセル新規オープン
    Set Book = App.Workbooks.Add
    
    '-------------------------------------------
    ' 結合先ワークブックにコピー
    '-------------------------------------------
    ' 先頭のファイル名の取得
    strFileName = Dir(FilePath & cnsDIR, vbNormal)
    
    ' ファイルが見つからなくなるまで繰り返す
    Do While strFileName <> ""
    
        '対象フォルダ配下のエクセルオープン
        Set Book2 = App.Workbooks.Open(Filename:=FilePath & "\" & strFileName)
        
        '開いたコピー元のエクセルのシート分繰り返す
        For i = 1 To Book2.Worksheets.Count
        
            '結合用のブックにシートコピー
            Book2.Worksheets(i).Copy after:=Book.Worksheets(i)
            'シート名を「元のエクセル名.元のシート名」に変更
            Book.ActiveSheet.Name = Book2.Name & "." & Book2.Worksheets(i).Name
        
        Next i
        
        'コピー元のエクセルを保存せずに閉じる
        Book2.Close (False)
        ' 次のファイル名を取得
        strFileName = Dir()
        
    Loop
    
    '-------------------------------------------
    ' 結合したエクセルの終了
    '-------------------------------------------
    '名前を付けて保存
    Book.SaveAs Filename:=FilePath & "\" & BookName
    'エクセルを閉じる
    Book.Close (False)

    '-------------------------------------------
    ' 終了処理
    '-------------------------------------------
    Set Sheet2 = Nothing
    Set Book2 = Nothing

    Set Sheet = Nothing
    Set Book = Nothing
    Set App = Nothing

    MsgBox "処理終了"

    '画面表示ON
    Application.ScreenUpdating = False

End Sub

'#############################################################################
' フォルダ参照用
'#############################################################################
Function FolderSelect() As String

    '-------------------------------------------
    ' 変数定義
    '-------------------------------------------
    Dim objFileDialog As Object             'FileDialog
    Dim strTitle As String                  'タイトル
    Dim strPath As String                   'フォルダパス
    Dim strInitialPath As String            '初期フォルダパス
    
    '-------------------------------------------
    ' フォルダ選択ダイアログの初期設定
    '-------------------------------------------
    'ダイアログタイトル
    strTitle = "結合元のフォルダを選択してください"
    'ダイアログの初期パスをモジュール起動エクセルに設定
    strInitialPath = ActiveWorkbook.Path
    
    '-------------------------------------------
    ' フォルダ選択ダイアログ表示
    '-------------------------------------------
    Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
        
    With objFileDialog
        'タイトル
        .Title = strTitle
        '初期フォルダパス
        .InitialFileName = strInitialPath
        
        If .Show = False Then
            'キャンセル時
            GoTo Exit_Function
        Else
            'フォルダパス取得
            strPath = .SelectedItems(1)
        End If
    
    End With
    
    '-------------------------------------------
    ' 終了処理
    '-------------------------------------------
Exit_Function:
    Set objFileDialog = Nothing
    
    FolderSelect = strPath

End Function

Adsense

関連記事

Microsoft Office

【Excel】関数を一括でメモ帳などにコピーする方法

  セルに入力されている関数一つのみコピーしたい場合、対象セルを選択して、数式バーか

記事を読む

Microsoft Office

【Outlook】送信時の0x80040201エラーの対処

発生した環境 OSはWindows7。Outlookは2013。イーモバイルのPocket W

記事を読む

Microsoft Office

【Outlook】開封メッセージ送信を先送りする技。

朝一でOutlookを起動したら、開封確認のメッセージ。 すごく嫌。個人的には、非常に嫌い。

記事を読む

データベース

【SQL Server】Excel VBAのレコードセットを使ってテーブルの一括更新

前々回は読み取り専用でレコードセットへ取得し、結果をエクセルへ書き出し 前回はVBAから更新S

記事を読む

Microsoft Office

【Access】エラーポップアップ。「少数を丸めたために、データが切り捨てられました。」

Accessのリンクテーブルでデータを確認していたら、急に・・・ 「少数を丸めたために

記事を読む

Microsoft Office

【Office】Access2007のピボットテーブルとExcel連携

仕事でAccess2007でEXCELみたいにピボットテーブルを使えますか? と質問を頂いた。

記事を読む

Microsoft Office

【Excel】複数項目を指定した昇順、降順の並べ替え方法

Excel 2013でのお話。 なぜかわからないが、Excelのオートフィルターを使うと単一の

記事を読む

Microsoft Office

【Access】クエリで小数点の切り下げ、切り上げ

Access2007には、roundup、rounddown関数がない。 なので、純粋に関数だ

記事を読む

Microsoft Office

【Excel】エクセルを起動(実行)しても、何も表示されない。

仕事の共有で使用しているエクセルを開くと、Excelの枠だけ表示されて何も表示されない。 壊れ

記事を読む

Microsoft Office

【Outlook】文字化けを直す方法

メールをチェックしているとプレビューウインドに文字化け表示。 メール(Outlook)

記事を読む

Adsense

Comment

  1. […] ード下記ブログ記事を参考。 IT Diary 【Excel】複数のエクセル(ブック)のシートを一つのブックに結合するVBA […]

  2. […] ード下記ブログ記事を参考。 IT Diary 【Excel】複数のエクセル(ブック)のシートを一つのブックに結合するVBA […]

  3. […] は下記ブログ記事を参考。 IT Diary 【Excel】複数のエクセル(ブック)のシートを一つのブックに結合するVBA […]

Message

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

Adsense

Microsoft Office
【Access】削除クエリの「指定されたテーブルから削除できませんでした。」の対処法

削除クエリで「指定されたテーブルから削除できませんでした。」と ポッ

Microsoft Office
【PowerPoint】表や図形、画像オブジェクトの位置をピッタリ合わせる方法

パワーポイントで、図形や画像等のオブジェクトの細かい位置調整は、 完

データベース
【SQL Server】Excel VBAのレコードセットを使ってテーブルの一括更新

前々回は読み取り専用でレコードセットへ取得し、結果をエクセルへ書き出し

application
【Visual Studio】デバック、ブレークポイントで止まらない。

Visual Studio 2015でVB.netのプログラムをデバッ

データベース
【SQL Server】Excel VBAでSELECT文を実行してレコードセットへ取得

前回は、テーブルのレコードをVBAで直接更新(Insert/updat

→もっと見る

PAGE TOP ↑