*

【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】エクセル。シートの名前を変更しようとしたらエラーポップアップ

エクセルでシート名を変更しようとしたときに… シートの名前をほかのシート、Visual B

記事を読む

Microsoft Office

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

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

記事を読む

Microsoft Office

【Outlook】保存フォルダ(archive.pst)が開けない。

急に「保存フォルダ」が開けなくなった。 Outlookのバージョンは、2007のSP3。

記事を読む

Microsoft Office

【Outlook】プレビューウインドウ(閲覧ウインドウ)で表示したら、メール既読のオフ設定

前回、「Outlookの開封メッセージ送信を先送りにする方法」で、少し書きましたが、 私用のメ

記事を読む

Microsoft Office

【Access】クエリ実行時に「引数が違います」と表示され実行できないときの対処法

Accessのクエリを実行すると 引数が違います とポップアップが表示され、クエリが実行できない

記事を読む

Microsoft Office

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

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

記事を読む

Microsoft Office

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

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

記事を読む

Microsoft Office

【Access2007】ODBCの罠。Windows7のコントロールパネルから作成したODBCがない。

Windows7の64bitでSQL Server 2012接続用のODBCを作成し Access

記事を読む

Microsoft Office

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

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

記事を読む

Microsoft Office

【Excel】「メモリまたはディスクの空き容量が~」のポップアップで開けない時の対処法

メモリまたはディスクの空き容量が不足しているため、ドキュメントを開いたり、保存したりできません。

記事を読む

Adsense

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 ↑