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関連

    Excel 2013版URLエンコードマクロ

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  2. Office関連

    テスト用の文字列を挿入するWordマクロ

    文字列操作を行うマクロを書いているとき、テスト用に「あいうえおかきくけ…

  3. Office関連

    受信メールに対して自動的に返信するOutlookマクロ

    「Outlook VBA 自動返信」といったキーワード検索でのアクセス…

  4. リボン関連

    A1セルを選択してから保存するExcelアドイン

    @yu_tang_さんのツイートで面白いものがありました。…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP