0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

(Excel) 複数ブックのシートを一つのブックにまとめるマクロ

Posted at

(Excel) 複数ブックのシートを一つのブックにまとめるマクロ

以前、報告書をマージする雑務を押し付けられたのでマクロを作成してみた。
マクロの内容は複数ブックのシートを1ファイルのブックにまとめるもの。

やりたいことのイメージ

例となるが、各チームの報告書が画像のように提出されるとする。
image.png
中身はこんな感じ。
image.png
今回のマクロを実行させ各チームの報告書をまとめたイメージが↓。
image.png
中身は各チームの報告書が入っている。
image.png

前提(注意点)

  • マージ元のシートは1シートのみであること。
  • 各ブックでシート名が重複しないこと。

事前準備

マクロ作成前の事前準備。

作業ディレクトリの作成

作業するためのディレクトリを作成する。

  • マージ元
  • マージ先
  • 集計ツール.xlsm(今回作成するマクロファイル。)
    image.png

マージ元ファイルの格納

マージ元のファイルを格納する。
※「やりたいことのイメージ」の最初の画像

マージ先ファイルの作成

事前にマージ先のディレクトリにエクセルファイルを作成する。
今回は「報告書.xlsx」としておく。
image.png

マクロ内容

今回のマクロ(集計ツール.xlsm)を作成していく。

ファイルイメージ

ファイルの中身のイメージ。
image.png

マクロボタンの設置

マージ作業で使用するマクロボタンを設置する。

  • ①ファイルパス取得
    マージ元ファイルの一覧を取得する。
    登録するマクロ関数:filePath
  • ②シート名取得
    一覧に表示された各ファイルのシートを取得する。
    登録するマクロ関数:sheetCheck
  • ③マージファイル作成
    一覧のマージ元のファイルを参照し、事前に配置したマージ先のファイルにシートをコピーする。
    登録するマクロ関数:merge

マージ先ファイルの記載

マクロファイルのセル:C11にマージ先ファイルのフルパスを記載しておく。

マクロ登録

各ボタンのマクロを記載する。

ファイルパス取得

「①ファイルパス取得」ボタンのマクロ

Sub filePath()
 Dim path As String 'ダイアログ選択時のファイルパス
 Dim fileName As String 'ファイル名
 Dim filePath As String 'ファイルパス(フルパス)
 Dim fileCount As Integer 'ファイル数
 Dim index As Integer 'インデックス
 
 'ディレクトリ選択用のダイアログを表示する
 With Application.FileDialog(msoFileDialogFolderPicker)
  'カレントディレクトリを指定
  .InitialFileName = ThisWorkbook.path
  
  '設定しなかったら終了
  If .Show = False Then Exit Sub
  
  '設定したディレクトリを表示
  path = .SelectedItems(1)
 
 End With
 
 'ファイル名を取得します。
 fileName = Dir(path & "\*")
 index = 0
 fileCount = 0
 Do While fileName <> ""
  'ファイルのフルパスを設定
  filePath = path & "\" & fileName
  'フルパス情報を出力
  Cells(11 + index, 1) = filePath
  'インデックスとファイルカウントをインクリメント
  index = index + 1
  fileCount = fileCount + 1
  
  '次ループ用のファイル名を取得
  fileName = Dir()
 Loop
 
 'ファイル数を記載
 Cells(9, 1) = fileCount

End Sub

シート名取得

「②シート名取得」ボタンのマクロ

Sub sheetCheck()
 Dim targetFile As String '処理対象ファイル
 Dim ws As Worksheet 'ワーク用WorkSheet
 Dim workBookName 'ワーク用ブック名
 Dim workSheetName 'ワーク用シート名
 Dim index As Integer 'インデックス
 
 'ファイル数分繰り返し処理をする
 For index = 1 To Cells(9, 1)
  '処理対象ファイルのフルパスを取得
  targetFile = Cells(10 + index, 1)
  
  '処理対象ファイルの1シート目のシート名を取得
  Set ws = Workbooks.Open(targetFile).Sheets(1)
  workBookName = ActiveWorkbook.Name
  'シート名を取得
  workSheetName = ws.Name
  '処理対象ファイルをクローズ
  Workbooks(workBookName).Close (False)
  'シート名を出力
  Cells(10 + index, 2) = workSheetName
  
 Next
 
 'シートの取得完了
 MsgBox ("シート名取得完了")

End Sub

マージファイル作成

「③マージファイル作成」ボタンのマクロ

Sub merge()
 Dim targetFile '処理対象ファイル
 Dim targetSheet '処理対象シート
 
 Dim ws As Worksheet 'ワーク用Worksheet
 Dim workBookName 'ワーク用ブック名
 Dim index As Integer 'インデックス
 
 Dim ms As Worksheet 'マージ用Worksheet
 Dim mergeBookName 'マージ用ブック名
 
 'ファイル数分繰り返し処理をする
 For index = 1 To Cells(9, 1)
  '処理対象ファイルのフルパスを取得
  targetFile = Cells(10 + index, 1)
  '処理対象ファイルのシート名を取得
  targetSheet = Cells(10 + index, 2)
  
  'マージファイルを開く
  Set ms = Workbooks.Open(Cells(11, 3)).Sheets(1)
  mergeBookName = ActiveWorkbook.Name
  
  '処理対象のファイルを開く
  Set ws = Workbooks.Open(targetFile).Sheets(targetSheet)
  workBookName = ActiveWorkbook.Name
  
  'マージ処理を実行
  Workbooks(workBookName).Worksheets(targetSheet).Activate
  ActiveSheet.Copy After:=Workbooks(mergeBookName).Sheets(Workbooks(mergeBookName).Worksheets.Count)
  
  '処理対象ファイルをクローズ
  Workbooks(workBookName).Close (False)
  'マージファイルをクローズ
  Workbooks(mergeBookName).Close (True)
 Next
 
 'マージ処理完了
 MsgBox ("マージ処理が正常に完了しました。")

End Sub

使い方

マージ元、マージ先のファイルを格納し、
マクロファイルの①~③の順でボタンを押下すればマージ完了。
②は目視となるがシートが重複していないか確認する用のボタン。

0
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?