Office関連

指定したフォルダ内にある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マクロ

    Microsoft コミュニティに「変更履歴とコメントの表示」オプショ…

  2. Office アドイン

    [Office用アプリ]第三回 Apps for Office 勉強会で登壇しました。

    10月4日(土)に開催されたOffice 用アプリの勉強会「第3回 A…

  3. Office関連

    図形の結合を行うPowerPoint マクロ(ExecuteMsoメソッド編)

    Excel MVPの伊藤さんのブログで、PowerPointの「図形の…

  4. Office アドイン

    [Office用アプリ]仕事の息抜きにピッタリ「もぐらミニ」

    KumaP氏作の作業ウィンドウアプリ「もぐらミニ」がOffice スト…

  5. Office関連

    Office 2013 アイコン一覧(H)

    ・Office 2013 アイコン一覧 NUM…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP