【Excel】複数のエクセル(ブック)のシートを一つのブックに結合するVBA
複数のエクセルのシートを一つのエクセルにまとめるVBAを作ってみた。
使い方
1.まとめたいエクセルを一つのフォルダへ集める
「*.xls*」で検索するので、エクセルファイル以外のファイルがあっても問題なし。
2.VBAの実行
3.対象フォルダの選択
4.選択した対象フォルダ内に「【結合】エクセル.xlsx」が作成される
「【結合】エクセル.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
関連記事
-
-
【Outlook】同期の失敗フォルダを消す方法
問い合わせで、Outlookの「同期の失敗」フォルダを消したいと受けた。 調べてみたけど、基本
-
-
【Access】リンクテーブルが接続(表示)できない。
Accessを使用していて、リンクテーブルが表示(接続)できない。 あまりないけど、困った時に
-
-
【Outlook】Gmailを使う時の設定(Gmailアカウント側)
OutlookでGmailを使用するには、Gmailのアカウント側でいくつか設定をしなければいけない
-
-
【PowerPoint】表や図形、画像オブジェクトの位置をピッタリ合わせる方法
パワーポイントで、図形や画像等のオブジェクトの細かい位置調整は、 完璧主義のこだわり派には非常にイ
-
-
【Microsoft Office】Access 2007でMDBファイルが開けない
こんばんわ。今日、ハマッたことを書きたいと思います。 会社の内線がなり「共有フォルダ上のAcces
-
-
【Access】クエリで小数点の切り下げ、切り上げ
Access2007には、roundup、rounddown関数がない。 なので、純粋に関数だ
-
-
【Access】リンクテーブルの一括変換。ODBCを使わずにSQL Serverへ接続
Accessのリンクテーブルの接続先を一括で変更する方法 この方法なら、ODBCを使用していな
-
-
【Excel】関数を一括でメモ帳などにコピーする方法
セルに入力されている関数一つのみコピーしたい場合、対象セルを選択して、数式バーか
-
-
【Access2007】ODBCを使ってSQL Server 2012に接続
Windows7のAccess2007をデータソース(ODBC)を使って、SQL Server 20
-
-
【SQL Server】Excel VBAのレコードセットを使ってテーブルの一括更新
前々回は読み取り専用でレコードセットへ取得し、結果をエクセルへ書き出し 前回はVBAから更新S
Comment
[…] ード下記ブログ記事を参考。 IT Diary 【Excel】複数のエクセル(ブック)のシートを一つのブックに結合するVBA […]
[…] ード下記ブログ記事を参考。 IT Diary 【Excel】複数のエクセル(ブック)のシートを一つのブックに結合するVBA […]
[…] は下記ブログ記事を参考。 IT Diary 【Excel】複数のエクセル(ブック)のシートを一つのブックに結合するVBA […]