*

【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

【Access】VBAを使わずにマクロでリンクテーブルの変更(変換)

以前にVBAを使ってリンクテーブルの変換をしましたが、 今回はVBAを使わずにマクロでリンクテーブ

記事を読む

Microsoft Office

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

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

記事を読む

Microsoft Office

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

パワーポイントで、図形や画像等のオブジェクトの細かい位置調整は、 完璧主義のこだわり派には非常にイ

記事を読む

Microsoft Office

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

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

記事を読む

Microsoft Office

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

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

記事を読む

Microsoft Office

【Access】「更新可能なクエリであることが必要です」のクエリのエラーポップアップ

Accessでクエリを作成し、実行すると 「更新可能なクエリであることが必要です。」

記事を読む

Microsoft Office

【拡張子:accde】Access2007でaccdeの使い道と作成方法

うちの職場ではEUC(End User Computing)として Access2007 を多用して

記事を読む

Microsoft Office

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

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

記事を読む

Microsoft Office

【Excel】VBAでセルの書き込みを5倍高速化する方法

Excel VBAで While文やFOR文を使用してループさせ、行、列をカウントアップして、 大

記事を読む

Microsoft Office

【Access】循環参照エラーの回避方法

Accessでクエリを実行しようとすると クエリ定義の SELECT で指定されている別名

記事を読む

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 ↑