Excel

指定したフォルダ内にあるExcelファイルを一つにまとめるVBAマクロ

複数あるファイルを一つにまとめるにはどうすれば良いか?という質問をいただいたので、簡単なマクロを書いてみました。
下記の通り、それぞれの処理の意味はコメントで記入してあります。

Option Explicit

Public Sub Sample()
  Dim bkWork As Workbook '作業用ワークブック
  Dim bkSrc As Workbook 'コピー元ワークブック
  Dim shtIni As Worksheet '初期ワークシート
  Dim folderPath As String '処理対象のフォルダパス
  Dim tmpSinw As Long 'SheetsInNewWorkbook一次記憶用
  Dim tmpDa As Boolean 'DisplayAlerts一次記憶用
  Dim itm As Object
  
  'Excelファイルが保存されているフォルダを選択
  With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False '複数選択しない
    .Title = "Excelファイルが保存されているフォルダを選択"
    If .Show = True Then
      folderPath = .SelectedItems(1) '選択したフォルダのパスを変数に格納
    Else
      Exit Sub 'フォルダが選択されなかった場合は処理終了
    End If
  End With
  
  '作業用ワークブックの作成
  With Application
    tmpSinw = .SheetsInNewWorkbook '新規ワークブックに自動的に挿入されるシート数を記憶
    .SheetsInNewWorkbook = 1
    Set bkWork = .Workbooks.Add 'ワークブック追加
    Set shtIni = bkWork.Sheets(1) '最初の空白ワークシートを記憶
    .SheetsInNewWorkbook = tmpSinw '新規ワークブックに自動的に挿入されるシート数を元に戻す
  End With
  
  'ファイルの処理にFileSystemObjectオブジェクトを利用
  With CreateObject("Scripting.FileSystemObject")
    '指定したフォルダ内のファイルを順番に処理
    For Each itm In .GetFolder(folderPath).Files
      '処理対象となるファイルの拡張子を指定
      Select Case LCase(.GetExtensionName(itm.Path))
        Case "xls", "xlsx", "xlsm", "csv"
          Set bkSrc = Application.Workbooks.Open(itm.Path) 'コピー元のワークブックを開く
          With bkWork
            '全シートを作業用ワークブックにコピー
            '※同名のワークシートがある場合は自動的にシート名が変更される
            bkSrc.Sheets.Copy After:=.Sheets(.Sheets.Count)
          End With
          bkSrc.Close SaveChanges:=False 'コピー元のワークブックを変更せずに閉じる
      End Select
    Next
  End With
  
  '最初の空白ワークシートを削除
  If bkWork.Sheets.Count > 1 Then
    With Application
      tmpDa = .DisplayAlerts '警告の表示状態を記憶
      .DisplayAlerts = False '警告の表示を無効に設定
      shtIni.Delete 'ワークシート削除
      .DisplayAlerts = tmpDa '警告の表示状態を元に戻す
    End With
  End If
End Sub

コードの貼り付け方や実行方法が分からない場合は、下記のような入門者向けのサイトをご参照ください。

初めてVBAに触れる方は、下記記事で紹介しているような初学者向けの書籍を参考にすることをお薦めいたします。

また、今回はマクロでの処理を紹介しましたが、ファイル数が少ない場合は、「[エクセル]異なるファイル(ブック)にシートを移動・コピーしたい」にある方法で、手動で処理しても良いかと思います。

関連記事

  1. Office関連

    [Word 2013]表形式のデータ入力にはコレが便利!?「コンテンツ繰り返しコントロール」の紹介

    Wordにはユーザー入力フォームを作るのに便利な機能「コンテンツ コン…

  2. アイコン一覧

    Office 2013 アイコン一覧(H)

    ・Office 2013 アイコン一覧 NUM…

  3. Office関連

    アラビア文字かどうかを判別するWordマクロ

    以前mougの質問用に書いたコードが出てきたので、一部修正しました。…

  4. Office アドイン

    [Office用アプリ]コピー&ペースト用マニフェストファイル

    Office 用アプリを作るとき、過去に作ったアプリのマニフェストファ…

  5. Excel

    CDOを使ってGmail送信を行うVBAマクロ

    「VBA Gmail 送信」といったキーワード検索で、「Gmail A…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP