【EXCEL：VBA】複数EXCELのシートを1つのEXCELファイルに集約したい（簡単2ステップ）

この記事では、複数EXCELの複数シートのそれぞれに入力されているデータを、1つのEXCELの複数シートそれぞれに集約する機能について説明しています。

同じ形式のデータが大量にある場合に、この機能は使えます。

例えば、全従業員から集めたデータや各拠点から集めたデータを集約するときに使えます。

1つ1つEXCELファイルを開いて、シートを選択し、行をコピーし、貼り付けして、ファイルを閉じる。

地味な作業ですが、大変ですし、ミスをしやすい作業です。

そんな大変な作業はこの機能を使えば、ボタン1つで正確に1つのEXCELの複数シートそれぞれに集約することができます。

それでは、複数EXCELの複数シートのそれぞれのデータを1つのEXCELの複数シートに集約する機能を作成していきましょう。

困っている女性

大量にあるEXCELの複数シートに入力されているデータを1つのEXCELに集約する作業があるんだけど、地味に大変なの・・・。

困っている女性

集約もれが発生したときなんか、もう大変なの。どのファイルのどのシートがもれたか探さないといけないの。泣きそうになるわ。

それなら、VBAを使えばもれなく正確に1つのEXCELのそれぞれのシートに集約することができるよ。

解決する男性

困っている女性

それそれ、早く教えてよ。

以下の記事では、似たような作業でEXCELデータを比較したり、差分を抽出する機能について説明しています。
今回の記事と合わせて、読んでみてください。

2020-06-28【EXCEL：VBA】2つのデータを比較したい

2020-07-01【EXCEL：VBA】2つのデータの差分を抽出したい

2020-07-03【EXCEL：VBA】複数のEXCELデータを1つに集約したい

複数EXCELの複数シートのデータを1つのEXCELの複数シートに集約する機能に必要なものを、1つ1つ順番に説明していきます。

【ステップ1】複数EXCELの複数シートを1つのEXCELの複数シートに集約するために必要なシートを作成する

「メイン」シートを作成する

メインシートを追加する

「メイン」という名前のシートを作成します。
1行目に「フォルダパス」のタイトル行を作成します。
2行目は「フォルダパス」を入力する行になります。
3行目に「集約後ファイル名」のタイトル行を作成します。
4行目は「集約後ファイル名」を入力する行になります。
5行目に「集約前ファイル名」、「シート名」、「集約開始行」のタイトル行を作成します。
6行目以降は「集約前ファイル名」、「シート名」を読込み、「集約開始行」を入力する欄になります。

「フォルダパス」には、複数EXCELファイルが保存されているフォルダパスを入力します。

「集約後ファイル名」には、集約したEXCELファイル名を入力します。

この「集約後ファイル」は、「フォルダパス」に作成されます。

「集約前ファイル名」には、「フォルダパス」に存在するEXCELファイル名がVBAプログラムで書込みされます。

「シート名」には、「フォルダパス」に存在するEXCELファイルの各シート名がVBAプログラムで書込みされます。

「集約開始行」には、それぞれのシートの集約したい開始行を入力します。

1つ目のシートからヘッダー行（タイトル行）を取得したい場合、1を入力します。

2つ目以降のシートからはヘッダー行（タイトル行）を除いて取得したい場合、2を入力します。

【ステップ2】複数EXCELの複数シートデータを1つのEXCELの複数シートに集約する機能を記入する

2つ機能が必要となります。

1つ目は、指定されたフォルダに存在する複数EXCELの複数シート名を取得する機能です。

2つ目は、1つのEXCELの複数シートにデータを集約する機能です。

それでは、それぞれのVBAプログラムを記入していきましょう。

「Microsoft Visual Basic for Applications」を起動します。

「指定されたフォルダに存在する複数EXCELの複数シート名を取得する」機能をVBAプログラムで作成する

VBAプログラム（その1）

標準モジュールを追加して、以下のソースを書きます。

Public Sub GetExcelSheet()
    Dim shtMain As Worksheet
    Dim fso As Object
    Dim f As Object
    Dim nowRow As Long
    Dim wb As Workbook
    Dim i As Integer
    
    '①参照するシートを変数に格納する
    Set shtMain = ThisWorkbook.Sheets("メイン")
        
    '②セルの値をクリアする
    shtMain.Range("A6:C10000").ClearContents
    
    '③FileSystemObjectを変数に格納する
    Set fso = CreateObject("Scripting.FileSystemObject")
     
    nowRow = 5
    
    '④指定されているフォルダに存在するファイル数分処理を繰り返す
    For Each f In fso.GetFolder(shtMain.Range("A2")).Files
    
        '⑤拡張子が「.xlsx」のみ対象とする
        If LCase(fso.getextensionName(f.Name)) = "xlsx" Then
            
            '⑥対象ブックを開く
            Set wb = Workbooks.Open(shtMain.Range("A2") & "\" & f.Name)
            
            For i = 1 To wb.Sheets.Count
            
                '⑦現在行を次の行に変更する
                nowRow = nowRow + 1
            
                '⑧ファイル名を書込みする
                shtMain.Range("A" & nowRow) = f.Name
                
                '⑨シート名を書込みする
                shtMain.Range("B" & nowRow) = wb.Sheets(i).Name
            Next
            
            '⑩ワークブックを閉じる
            wb.Close
            
            '⑪ワークブック変数をクリアする
            Set wb = Nothing
            
        End If
    Next
        
    '⑫FileSystemObjectをクリアする
    Set fso = Nothing
    
    MsgBox "完了"
End Sub

Public Sub GetExcelSheet()

Dim shtMain As Worksheet

Dim fso As Object

Dim f As Object

Dim nowRow As Long

Dim wb As Workbook

Dim i As Integer

'①参照するシートを変数に格納する

Set shtMain = ThisWorkbook.Sheets("メイン")

'②セルの値をクリアする

shtMain.Range("A6:C10000").ClearContents

'③FileSystemObjectを変数に格納する

Set fso = CreateObject("Scripting.FileSystemObject")

nowRow = 5

'④指定されているフォルダに存在するファイル数分処理を繰り返す

For Each f In fso.GetFolder(shtMain.Range("A2")).Files

'⑤拡張子が「.xlsx」のみ対象とする

If LCase(fso.getextensionName(f.Name)) = "xlsx" Then

'⑥対象ブックを開く

Set wb = Workbooks.Open(shtMain.Range("A2") & "\" & f.Name)

For i = 1 To wb.Sheets.Count

'⑦現在行を次の行に変更する

nowRow = nowRow + 1

'⑧ファイル名を書込みする

shtMain.Range("A" & nowRow) = f.Name

'⑨シート名を書込みする

shtMain.Range("B" & nowRow) = wb.Sheets(i).Name

'⑩ワークブックを閉じる

wb.Close

'⑪ワークブック変数をクリアする

Set wb = Nothing

End If

'⑫FileSystemObjectをクリアする

Set fso = Nothing

MsgBox "完了"

End Sub

「1つのEXCELの複数シートにデータを集約する」機能をVBAプログラムで作成する

VBAプログラム（その2）

VBAプログラム（その3）

VBAプログラム（その4）

標準モジュールに以下のソースを書きます。

Public Sub SyuyakuExcelSheet()
    Dim shtMain As Worksheet
    Dim fso As Object
    Dim f As Object
    Dim nowRow As Long
    Dim wb As Workbook
    Dim i As Integer
    Dim names() As String
    Dim blnExist As Boolean
    Dim shtNew As Worksheet
    Dim wbTaisyo As Workbook
    Dim shtTaisyo As Worksheet
    Dim shtSyuyaku As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim startRow As Long
    Dim shtName As String
    
    '①参照するシートを変数に格納する
    Set shtMain = ThisWorkbook.Sheets("メイン")
     
    nowRow = 5
    
    '②動的配列の初期化
    ReDim names(0)
    
    names(0) = ""
    
    Do While True
    
        '③現在行を次の行に変更する
        nowRow = nowRow + 1
        
        '④「集約前ファイル名」が空かチェックする
        If shtMain.Range("A" & nowRow) = "" Then
            Exit Do
        End If
        
        blnExist = False
        
        '⑤動的配列にシート名が存在するかチェックする
        For i = 0 To UBound(names)
            If names(i) = shtMain.Range("B" & nowRow) Then
                blnExist = True
                Exit For
            End If
        Next
        
        '⑥動的配列にシート名が存在しない場合、動的配列に追加する
        If blnExist = False Then
            If names(UBound(names)) = "" Then
                names(UBound(names)) = shtMain.Range("B" & nowRow)
            Else
                ReDim Preserve names(UBound(names) + 1)
                names(UBound(names)) = shtMain.Range("B" & nowRow)
            End If
        End If
    Loop
    
    '⑦新しいワークブックを作成する
    Set wb = Workbooks.Add
    
    '⑧動的配列のシート名でシートを追加する
    For i = 0 To UBound(names)
        Set shtNew = wb.Sheets.Add
        
        shtNew.Name = names(i)
        
        Set shtNew = Nothing
    Next
        
    nowRow = 5
        
    Do While True
    
        '⑨現在行を次の行に変更する
        nowRow = nowRow + 1
        
        '⑩「集約前ファイル名」が空かチェックする
        If shtMain.Range("A" & nowRow) = "" Then
            Exit Do
        End If
        
        '⑪集約前ファイルを開く
        Set wbTaisyo = Workbooks.Open(shtMain.Range("A2") & "\" & shtMain.Range("A" & nowRow))
        
        '⑫シート名を変数に格納する
        shtName = shtMain.Range("B" & nowRow)
        
        '⑬集約前ファイルのシートを変数に格納する
        Set shtTaisyo = wbTaisyo.Sheets(shtName)
        
        '⑭集約後ファイルのシートを変数に格納する
        Set shtSyuyaku = wb.Sheets(shtName)
        
        '⑮集約前ファイルの対象シートの最終行を取得する
        lastRow = shtTaisyo.Cells(shtTaisyo.Rows.Count, 1).End(xlUp).Row
        
        '⑯集約前ファイルの対象シートの最終列を取得する
        lastCol = shtTaisyo.Cells(1, shtTaisyo.Columns.Count).End(xlToLeft).Column
        
        '⑰集約後ファイルの集約先シートの貼り付け位置を取得する
        startRow = shtSyuyaku.Cells(shtSyuyaku.Rows.Count, 1).End(xlUp).Row
        
        '⑱はじめての貼り付け以外のとき、プラス1する
        If startRow <> 1 Then
            startRow = startRow + 1
        End If
        
        '⑲対象シートの対象データを集約後シートにコピーする
        shtTaisyo.Range(shtTaisyo.Cells(shtMain.Range("C" & nowRow), 1), _
                        shtTaisyo.Cells(lastRow, lastCol)).Copy _
                        (shtSyuyaku.Cells(startRow, 1))
        
        wbTaisyo.Close
        
        Set shtSyuyaku = Nothing
        Set shtTaisyo = Nothing
        Set wbTaisyo = Nothing
    Loop
        
    '⑳集約後ファイルに名前をつけて、閉じる
    wb.Close True, shtMain.Range("A" & 2) & "\" & shtMain.Range("A" & 4)
    
    Set wb = Nothing
    
    MsgBox "完了"
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

Public Sub SyuyakuExcelSheet()

Dim shtMain As Worksheet

Dim fso As Object

Dim f As Object

Dim nowRow As Long

Dim wb As Workbook

Dim i As Integer

Dim names() As String

Dim blnExist As Boolean

Dim shtNew As Worksheet

Dim wbTaisyo As Workbook

Dim shtTaisyo As Worksheet

Dim shtSyuyaku As Worksheet

Dim lastRow As Long

Dim lastCol As Long

Dim startRow As Long

Dim shtName As String

'①参照するシートを変数に格納する

Set shtMain = ThisWorkbook.Sheets("メイン")

nowRow = 5

'②動的配列の初期化

ReDim names(0)

names(0) = ""

Do While True

'③現在行を次の行に変更する

nowRow = nowRow + 1

'④「集約前ファイル名」が空かチェックする

If shtMain.Range("A" & nowRow) = "" Then

Exit Do

End If

blnExist = False

'⑤動的配列にシート名が存在するかチェックする

For i = 0 To UBound(names)

If names(i) = shtMain.Range("B" & nowRow) Then

blnExist = True

Exit For

End If

'⑥動的配列にシート名が存在しない場合、動的配列に追加する

If blnExist = False Then

If names(UBound(names)) = "" Then

names(UBound(names)) = shtMain.Range("B" & nowRow)

Else

ReDim Preserve names(UBound(names) + 1)

names(UBound(names)) = shtMain.Range("B" & nowRow)

End If

Loop

'⑦新しいワークブックを作成する

Set wb = Workbooks.Add

'⑧動的配列のシート名でシートを追加する

For i = 0 To UBound(names)

Set shtNew = wb.Sheets.Add

shtNew.Name = names(i)

Set shtNew = Nothing

nowRow = 5

Do While True

'⑨現在行を次の行に変更する

nowRow = nowRow + 1

'⑩「集約前ファイル名」が空かチェックする

If shtMain.Range("A" & nowRow) = "" Then

Exit Do

End If

'⑪集約前ファイルを開く

Set wbTaisyo = Workbooks.Open(shtMain.Range("A2") & "\" & shtMain.Range("A" & nowRow))

'⑫シート名を変数に格納する

shtName = shtMain.Range("B" & nowRow)

'⑬集約前ファイルのシートを変数に格納する

Set shtTaisyo = wbTaisyo.Sheets(shtName)

'⑭集約後ファイルのシートを変数に格納する

Set shtSyuyaku = wb.Sheets(shtName)

'⑮集約前ファイルの対象シートの最終行を取得する

lastRow = shtTaisyo.Cells(shtTaisyo.Rows.Count, 1).End(xlUp).Row

'⑯集約前ファイルの対象シートの最終列を取得する

lastCol = shtTaisyo.Cells(1, shtTaisyo.Columns.Count).End(xlToLeft).Column

'⑰集約後ファイルの集約先シートの貼り付け位置を取得する

startRow = shtSyuyaku.Cells(shtSyuyaku.Rows.Count, 1).End(xlUp).Row

'⑱はじめての貼り付け以外のとき、プラス1する

If startRow <> 1 Then

startRow = startRow + 1

End If

'⑲対象シートの対象データを集約後シートにコピーする

shtTaisyo.Range(shtTaisyo.Cells(shtMain.Range("C" & nowRow), 1), _

shtTaisyo.Cells(lastRow, lastCol)).Copy _

(shtSyuyaku.Cells(startRow, 1))

wbTaisyo.Close

Set shtSyuyaku = Nothing

Set shtTaisyo = Nothing

Set wbTaisyo = Nothing

Loop

'⑳集約後ファイルに名前をつけて、閉じる

wb.Close True, shtMain.Range("A" & 2) & "\" & shtMain.Range("A" & 4)

Set wb = Nothing

MsgBox "完了"

End Sub

今回は、少しVBAプログラムが複雑になりましたが、頑張って記入しましょう。

【機能の使い方】複数EXCELの複数シートを1つのEXCELの複数シートに集約する

それでは、集約したいEXCELファイルを用意します。

今回のサンプルでは、「従業員マスタ」と「売上明細」の2つのシートを持ったEXCELファイルを用意しました。

「従業員マスタ」シートは、「従業員番号」、「氏名」が入力されています。

「従業員マスタ」シート

「売上明細」シートは、「日付」、「従業員番号」、「売上金額」が入力されています。

「売上明細」シート

お好きな形式のデータを集約することができます。

集約したいEXCELファイルを1つのフォルダに保存します。

今回のサンプルではファイル3つ用意していますが、必要なだけファイルを保存してください。

集約するEXCELファイルを準備する

それでは、今回用意したサンプルのEXCELファイル3つを1つのEXCELの複数シートに集約していきます。

「メイン」シートの「フォルダパス」、「集約後ファイル名」を入力します。

次に、「開発」タブの「マクロ」ボタンをクリックします。

マクロボタンをクリックする

先程作成した自作関数「GetExcelSheet」が一覧に表示されていますので、選択します。

次に、「実行」ボタンをクリックして集約前ファイル情報を取得します。

「GetExcelSheet」を実行する

少し待つと、複数EXCELの複数シートの情報が「メイン」シートに書込みされます。

EXCELファイル名とシート名が書込みされています。

集約前ファイルの情報が書き込まれた

次に、それぞれのシートの集約開始行をC列に入力しましょう。

集約開始行を入力する

上記の画像では、「A1001.xlsx」の「従業員マスタ」と「売上明細」のみ「集約開始行」に1を入力しました。

それ以外のシートについては、2を入力しました。

最初の「従業員マスタ」と「売上明細」のみヘッダー行（タイトル行）を含めて取得するためです。

それ以外のシートでは、ヘッダー行を除いてデータ行から取得します。

次に、「開発」タブの「マクロ」ボタンをクリックします。

マクロボタンをクリックする

先程作成した自作関数「SyuyakuExcelSheet」が一覧に表示されていますので、選択します。

次に、「実行」ボタンをクリックして1つのEXCELの複数シートにデータを集約します。

「SyuyakuExcelSheet」を実行する

少し待つと、集約したEXCELファイルが作成されます。

集約後ファイルが作成された

以下のように、「売上明細」が集約されます。

「売上明細」シートが集約される

また、「従業員マスタ」も集約されています。

「従業員マスタ」シートが集約された

今回は、3つのEXCELファイルの2つのシートを集約しました。

どうですか、簡単でしょ。

もっとたくさんのEXCELファイルでも、同じく簡単ですのでやってみてください。

【VBAプログラムの説明】指定されたフォルダに存在する複数EXCELの複数シート名を取得する

それでは、「指定されたフォルダに存在する複数EXCELの複数シート名を取得する」VBAプログラムを説明します。

①「メイン」シートを変数に格納する

'①参照するシートを変数に格納する
Set shtMain = ThisWorkbook.Sheets("メイン")

1 2	'①参照するシートを変数に格納する Set shtMain = ThisWorkbook.Sheets("メイン")

ここでは、このあとの処理で使う「メイン」シートを変数に格納しています。

②セルの値をクリアする

'②セルの値をクリアする
shtMain.Range("A6:C10000").ClearContents

1 2	'②セルの値をクリアする shtMain.Range("A6:C10000").ClearContents

ここでは、メインシートの6行目以降をクリアしています。

何度も実行する可能性があるため、後続処理を行う前にクリアをします。

③FileSystemObjectを変数に格納する

'③FileSystemObjectを変数に格納する
Set fso = CreateObject("Scripting.FileSystemObject")

1 2	'③FileSystemObjectを変数に格納する Set fso = CreateObject("Scripting.FileSystemObject")

ここでは、この後で利用する「FileSystemObject」を変数に格納しています。

④指定されているフォルダに存在するファイル数分処理を繰り返す

'④指定されているフォルダに存在するファイル数分処理を繰り返す
For Each f In fso.GetFolder(shtMain.Range("A2")).Files

1 2	'④指定されているフォルダに存在するファイル数分処理を繰り返す For Each f In fso.GetFolder(shtMain.Range("A2")).Files

ここでは、メインシートの「フォルダパス」で指定されているフォルダに存在するEXCELファイル数分、後続処理を繰り返します。

具体的には、EXCELファイル名とシート名を取得して、「メイン」シートに書込みする処理を繰り返します。

⑤拡張子が「.xlsx」のみ対象とする

'⑤拡張子が「.xlsx」のみ対象とする
If LCase(fso.getextensionName(f.Name)) = "xlsx" Then

1 2	'⑤拡張子が「.xlsx」のみ対象とする If LCase(fso.getextensionName(f.Name)) = "xlsx" Then

ここでは、フォルダに存在するファイルの拡張子が「xlsx」か確認しています。

拡張子が「xlsx」以外なら処理をしません。

⑥対象ブックを開く

'⑥対象ブックを開く
Set wb = Workbooks.Open(shtMain.Range("A2") & "\" & f.Name)

1 2	'⑥対象ブックを開く Set wb = Workbooks.Open(shtMain.Range("A2") & "\" & f.Name)

ここでは、EXCELファイルを開きます。

なぜなら、シート名を取得するためです。

⑦現在行を次の行に変更する

'⑦現在行を次の行に変更する
nowRow = nowRow + 1

1 2	'⑦現在行を次の行に変更する nowRow = nowRow + 1

ここでは、現在行を次の行に変更しています。

nowRowには5が格納されています。

プラス1して6とし、6行目から順番に処理を行うためです。

⑧ファイル名を書込みする

'⑧ファイル名を書込みする
shtMain.Range("A" & nowRow) = f.Name

1 2	'⑧ファイル名を書込みする shtMain.Range("A" & nowRow) = f.Name

ここでは、メインシートにEXCELファイル名をA列に書込みしています。

⑨シート名を書込みする

'⑨シート名を書込みする
shtMain.Range("B" & nowRow) = wb.Sheets(i).Name

1 2	'⑨シート名を書込みする shtMain.Range("B" & nowRow) = wb.Sheets(i).Name

ここでは、メインシートに取得したシート名をB列に書込みしています。

⑩ワークブックを閉じる

'⑩ワークブックを閉じる
wb.Close

1 2	'⑩ワークブックを閉じる wb.Close

ここでは、開いていたEXCELファイルを閉じています。

⑪ワークブック変数をクリアする

'⑪ワークブック変数をクリアする
Set wb = Nothing

1 2	'⑪ワークブック変数をクリアする Set wb = Nothing

ここでは、ワークブック変数をクリアして、次で利用できるように準備しています。

⑫FileSystemObjectをクリアする

'⑫FileSystemObjectをクリアする
Set fso = Nothing

1 2	'⑫FileSystemObjectをクリアする Set fso = Nothing

ここでは、ファイル操作で利用した「FileSystemObject」をクリアしています。

以上です。

【VBAプログラムの説明】複数EXCELの複数シートのデータを1つのEXCELの複数シートに集約する

それでは、「複数EXCELの複数シートのデータを1つのEXCELの複数シートに集約する」VBAプログラムを説明します。

①「メイン」シートを変数に格納する

'①「メイン」シートを変数に格納する
Set shtMain = ThisWorkbook.Sheets("メイン")

1 2	'①「メイン」シートを変数に格納する Set shtMain = ThisWorkbook.Sheets("メイン")

ここでは、このあとの処理で使う「メイン」シートを変数に格納しています。

②動的配列の初期化

'②動的配列の初期化
ReDim names(0)

1 2	'②動的配列の初期化 ReDim names(0)

ここでは、取得してきたシート名を格納する動的配列を初期化しています。

③現在行を次の行に変更する

'③現在行を次の行に変更する
nowRow = nowRow + 1

1 2	'③現在行を次の行に変更する nowRow = nowRow + 1

ここでは、現在行をプラス1して、次の行に変更しています。

④「集約前ファイル名」が空かチェックする

'④「集約前ファイル名」が空かチェックする
If shtMain.Range("A" & nowRow) = "" Then
    Exit Do
End If

'④「集約前ファイル名」が空かチェックする

If shtMain.Range("A" & nowRow) = "" Then

Exit Do

End If

ここでは、「集約前ファイル名」が空かチェックしています。

空なら処理を終了します。

⑤動的配列にシート名が存在するかチェックする

'⑤動的配列にシート名が存在するかチェックする
For i = 0 To UBound(names)
    If names(i) = shtMain.Range("B" & nowRow) Then
        blnExist = True
        Exit For
    End If
Next

'⑤動的配列にシート名が存在するかチェックする

For i = 0 To UBound(names)

If names(i) = shtMain.Range("B" & nowRow) Then

blnExist = True

Exit For

End If

ここでは、動的配列にすでにシート名が存在するかチェックしています。

⑥動的配列にシート名が存在しない場合、動的配列に追加する

'⑥動的配列にシート名が存在しない場合、動的配列に追加する
If blnExist = False Then
    If names(UBound(names)) = "" Then
        names(UBound(names)) = shtMain.Range("B" & nowRow)
    Else
        ReDim Preserve names(UBound(names) + 1)
        names(UBound(names)) = shtMain.Range("B" & nowRow)
    End If
End If

'⑥動的配列にシート名が存在しない場合、動的配列に追加する

If blnExist = False Then

If names(UBound(names)) = "" Then

names(UBound(names)) = shtMain.Range("B" & nowRow)

Else

ReDim Preserve names(UBound(names) + 1)

names(UBound(names)) = shtMain.Range("B" & nowRow)

End If

ここでは、動的配列に格納されていないシート名を追加しています。

⑦新しいワークブックを作成する

'⑦新しいワークブックを作成する
Set wb = Workbooks.Add

1 2	'⑦新しいワークブックを作成する Set wb = Workbooks.Add

ここでは、新しいワークブックを作成しています。

このワークブックは、データを集約した結果を書込みするEXCELです。

⑧動的配列のシート名でシートを追加する

'⑧動的配列のシート名でシートを追加する
For i = 0 To UBound(names)
	Set shtNew = wb.Sheets.Add

	shtNew.Name = names(i)

	Set shtNew = Nothing
Next

'⑧動的配列のシート名でシートを追加する

For i = 0 To UBound(names)

Set shtNew = wb.Sheets.Add

shtNew.Name = names(i)

Set shtNew = Nothing

ここでは、動的配列に格納されているシート名で、新しいワークブックにシートを追加しています。

⑨現在行を次の行に変更する

'⑨現在行を次の行に変更する
nowRow = nowRow + 1

1 2	'⑨現在行を次の行に変更する nowRow = nowRow + 1

ここでは、現在の行をプラス1して、次の行にしています。

⑩「集約前ファイル名」が空かチェックする

'⑩「集約前ファイル名」が空かチェックする
If shtMain.Range("A" & nowRow) = "" Then
    Exit Do
End If

'⑩「集約前ファイル名」が空かチェックする

If shtMain.Range("A" & nowRow) = "" Then

Exit Do

End If

ここでは、メインシートの「集約前ファイル名」が空かチェックしています。

空が見つかったら、処理を終了します。

⑪集約前ファイルを開く

'⑪集約前ファイルを開く
Set wbTaisyo = Workbooks.Open(shtMain.Range("A2") & "\" & shtMain.Range("A" & nowRow))

1 2	'⑪集約前ファイルを開く Set wbTaisyo = Workbooks.Open(shtMain.Range("A2") & "\" & shtMain.Range("A" & nowRow))

ここでは、集約前のEXCELファイルを開いています。

⑫シート名を変数に格納する

'⑫シート名を変数に格納する
shtName = shtMain.Range("B" & nowRow)

1 2	'⑫シート名を変数に格納する shtName = shtMain.Range("B" & nowRow)

ここでは、メインシートに入力されているシート名を変数に格納しています。

⑬集約前ファイルのシートを変数に格納する

'⑬集約前ファイルのシートを変数に格納する
Set shtTaisyo = wbTaisyo.Sheets(shtName)

1 2	'⑬集約前ファイルのシートを変数に格納する Set shtTaisyo = wbTaisyo.Sheets(shtName)

ここでは、集約前のEXCELのシートを変数に格納しています。

このシートに入力されているデータを取得するために、準備しています。

⑭集約後ファイルのシートを変数に格納する

'⑭集約後ファイルのシートを変数に格納する
Set shtSyuyaku = wb.Sheets(shtName)

1 2	'⑭集約後ファイルのシートを変数に格納する Set shtSyuyaku = wb.Sheets(shtName)

ここでは、集約後のEXCELファイルの集約先シートを変数に格納しています。

取得した集約前シートのデータを貼り付けるために、準備しています。

⑮集約前ファイルの対象シートの最終行を取得する

'⑮集約前ファイルの対象シートの最終行を取得する
lastRow = shtTaisyo.Cells(shtTaisyo.Rows.Count, 1).End(xlUp).Row

1 2	'⑮集約前ファイルの対象シートの最終行を取得する lastRow = shtTaisyo.Cells(shtTaisyo.Rows.Count, 1).End(xlUp).Row

ここでは、集約前のEXCELファイルのシートの最終行を取得しています。

取得するデータ範囲を知るためです。

⑯集約前ファイルの対象シートの最終列を取得する

'⑯集約前ファイルの対象シートの最終列を取得する
lastCol = shtTaisyo.Cells(1, shtTaisyo.Columns.Count).End(xlToLeft).Column

1 2	'⑯集約前ファイルの対象シートの最終列を取得する lastCol = shtTaisyo.Cells(1, shtTaisyo.Columns.Count).End(xlToLeft).Column

ここでは、集約前のEXCELファイルのシートの最終列を取得しています。

取得するデータ範囲を知るためです。

⑰集約後ファイルの集約先シートの貼り付け位置を取得する

'⑰集約後ファイルの集約先シートの貼り付け位置を取得する
startRow = shtSyuyaku.Cells(shtSyuyaku.Rows.Count, 1).End(xlUp).Row

1 2	'⑰集約後ファイルの集約先シートの貼り付け位置を取得する startRow = shtSyuyaku.Cells(shtSyuyaku.Rows.Count, 1).End(xlUp).Row

ここでは、集約後ファイルの集約先シートのデータが入力されている最終行を取得しています。

なぜなら、次に貼り付け開始行を知るためです。

⑱はじめての貼り付け以外のとき、プラス1する

'⑱はじめての貼り付け以外のとき、プラス1する
If startRow <> 1 Then
    startRow = startRow + 1
End If

'⑱はじめての貼り付け以外のとき、プラス1する

If startRow <> 1 Then

startRow = startRow + 1

End If

ここでは、はじめてデータを貼り付けする場合以外、貼り付け開始行をプラス1しています。

なぜなら、まだ貼付けされていない場合はシートの1行目になるからです。

また、すでにデータが貼付けされている場合、データが存在する最終行の次の行から貼り付けをしたいからです。

⑲対象シートの対象データを集約後シートにコピーする

'⑲対象シートの対象データを集約後シートにコピーする
shtTaisyo.Range(shtTaisyo.Cells(shtMain.Range("C" & nowRow), 1), _
                shtTaisyo.Cells(lastRow, lastCol)).Copy _
                (shtSyuyaku.Cells(startRow, 1))

'⑲対象シートの対象データを集約後シートにコピーする

shtTaisyo.Range(shtTaisyo.Cells(shtMain.Range("C" & nowRow), 1), _

shtTaisyo.Cells(lastRow, lastCol)).Copy _

(shtSyuyaku.Cells(startRow, 1))

ここでは、集約前EXCELファイルのシートのデータを、集約後EXCELファイルのシートにコピーしています。

集約前EXCELのシートの開始行は、メインシートに入力されている「集約開始行」を指定しています。

ここで、ヘッダー行を含めるか、含めないかを制御しています。

⑳集約後ファイルに名前をつけて、閉じる

'⑳集約後ファイルに名前をつけて、閉じる
wb.Close True, shtMain.Range("A" & 2) & "\" & shtMain.Range("A" & 4)

1 2	'⑳集約後ファイルに名前をつけて、閉じる wb.Close True, shtMain.Range("A" & 2) & "\" & shtMain.Range("A" & 4)

ここでは、集約後EXCELファイルに名前をつけて、閉じています。

ファイル名は、メインシートのA4セルに入力されている値を利用しています。

それでは、集約したいデータを用意して、1つに集約してみましょう。

以上です。

【ステップ1】複数EXCELの複数シートを1つのEXCELの複数シートに集約するために必要なシートを作成する

「メイン」シートを作成する

【ステップ2】複数EXCELの複数シートデータを1つのEXCELの複数シートに集約する機能を記入する

「指定されたフォルダに存在する複数EXCELの複数シート名を取得する」機能をVBAプログラムで作成する

「1つのEXCELの複数シートにデータを集約する」機能をVBAプログラムで作成する

【機能の使い方】複数EXCELの複数シートを1つのEXCELの複数シートに集約する

【VBAプログラムの説明】指定されたフォルダに存在する複数EXCELの複数シート名を取得する

①「メイン」シートを変数に格納する

②セルの値をクリアする

③FileSystemObjectを変数に格納する

④指定されているフォルダに存在するファイル数分処理を繰り返す

⑤拡張子が「.xlsx」のみ対象とする

⑥対象ブックを開く

⑦現在行を次の行に変更する

⑧ファイル名を書込みする

⑨シート名を書込みする

⑩ワークブックを閉じる

⑪ワークブック変数をクリアする

⑫FileSystemObjectをクリアする

【VBAプログラムの説明】複数EXCELの複数シートのデータを1つのEXCELの複数シートに集約する

①「メイン」シートを変数に格納する

②動的配列の初期化

③現在行を次の行に変更する

④「集約前ファイル名」が空かチェックする

⑤動的配列にシート名が存在するかチェックする

⑥動的配列にシート名が存在しない場合、動的配列に追加する

⑦新しいワークブックを作成する

⑧動的配列のシート名でシートを追加する

⑨現在行を次の行に変更する

⑩「集約前ファイル名」が空かチェックする

⑪集約前ファイルを開く

⑫シート名を変数に格納する

⑬集約前ファイルのシートを変数に格納する

⑭集約後ファイルのシートを変数に格納する

⑮集約前ファイルの対象シートの最終行を取得する

⑯集約前ファイルの対象シートの最終列を取得する

⑰集約後ファイルの集約先シートの貼り付け位置を取得する

⑱はじめての貼り付け以外のとき、プラス1する

⑲対象シートの対象データを集約後シートにコピーする

⑳集約後ファイルに名前をつけて、閉じる

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル