コメントありがとうございます！ かなり実務的な内容ですね（^^） ご質問の内容としては、次のような手順で取得できるかと思います。 ・サブフォルダのフォルダパスを取得 ・サブフォルダ内のファイルパスを取得 ・すべてのブックをループ ・ブック内のシートをループ ・シートのデータとブック名とシート名を取得 VBAコードとしては、次のようになります。 Sub TEST1() Dim FolderPath 'フォルダパスを指定 FolderPath = ThisWorkbook.Path & "\TEST" Dim FSO 'FSOを作成 Set FSO = CreateObject("Scripting.FileSystemObject") Dim A 'サブフォルダをループ For Each Folder In FSO.GetFolder(FolderPath).SubFolders 'フォルダ内のファイルをループ For Each File In FSO.GetFolder(Folder).Files Workbooks.Open File 'ブックを開く 'シートをループ For Each A In Sheets With A.Range("A1").CurrentRegion 'データを取得 .Resize(.Rows.Count - 1).Offset(1, 0).Copy ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0) 'ブックパスを取得 ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(.Rows.Count - 1) = ActiveWorkbook.Name 'シート名を取得 ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(.Rows.Count - 1) = A.Name End With Next 'ブックを閉じる ActiveWorkbook.Close Next Next End Sub フォルダとブック、シート構成としては、次のように作成しております。 ・トップのフォルダとして「TEST」のフォルダを作成 ・「TEST」フォルダ内に「TEST1」～「TEST3」を作成 ・それぞれのフォルダ内に「2022年1月.xlsx」～「2022年3月.xlsx」のブックを保存 ・それぞれのブック内に「2022年1月1日」～「2022年3月」のシートを作成 ・シートのデータは「商品」と「価格」のデータを保存 という構成となっております。 そして、マクロブックと同じ階層に「TEST」フォルダを保存しております。 VBAコードを実行すると、次のようにすべてのフォルダ内のすべてのブックから、すべてのシートのデータを取得することができます。 ブック名 シート名 商品 価格 2022月1月.xlsx 2022年1月1日 A 100 2022月1月.xlsx 2022年1月1日 B 200 2022月1月.xlsx 2022年1月1日 C 300 2022月1月.xlsx 2022年1月2日 D 400 2022月1月.xlsx 2022年1月2日 E 500 2022月1月.xlsx 2022年1月2日 F 600 2022月1月.xlsx 2022年1月3日 G 700 2022月1月.xlsx 2022年1月3日 H 800 2022月1月.xlsx 2022年1月3日 I 900 2022月2月.xlsx 2022年2月1日 A 100 2022月2月.xlsx 2022年2月1日 B 200 2022月2月.xlsx 2022年2月1日 C 300 2022月2月.xlsx 2022年2月2日 D 400 2022月2月.xlsx 2022年2月2日 E 500 2022月2月.xlsx 2022年2月2日 F 600 2022月2月.xlsx 2022年2月3日 G 700 2022月2月.xlsx 2022年2月3日 H 800 2022月2月.xlsx 2022年2月3日 I 900 2022月3月.xlsx 2022年3月1日 A 100 2022月3月.xlsx 2022年3月1日 B 200 2022月3月.xlsx 2022年3月1日 C 300 2022月3月.xlsx 2022年3月2日 D 400 2022月3月.xlsx 2022年3月2日 E 500 2022月3月.xlsx 2022年3月2日 F 600 2022月3月.xlsx 2022年3月3日 G 700 2022月3月.xlsx 2022年3月3日 H 800 2022月3月.xlsx 2022年3月3日 I 900 2023月1月.xlsx 2022年1月1日 A 100 2023月1月.xlsx 2022年1月1日 B 200 2023月1月.xlsx 2022年1月1日 C 300 2023月1月.xlsx 2022年1月2日 D 400 2023月1月.xlsx 2022年1月2日 E 500 2023月1月.xlsx 2022年1月2日 F 600 2023月1月.xlsx 2022年1月3日 G 700 2023月1月.xlsx 2022年1月3日 H 800 2023月1月.xlsx 2022年1月3日 I 900 2023月2月.xlsx 2022年2月1日 A 100 2023月2月.xlsx 2022年2月1日 B 200 2023月2月.xlsx 2022年2月1日 C 300 2023月2月.xlsx 2022年2月2日 D 400 2023月2月.xlsx 2022年2月2日 E 500 2023月2月.xlsx 2022年2月2日 F 600 2023月2月.xlsx 2022年2月3日 G 700 2023月2月.xlsx 2022年2月3日 H 800 2023月2月.xlsx 2022年2月3日 I 900 2023月3月.xlsx 2022年3月1日 A 100 2023月3月.xlsx 2022年3月1日 B 200 2023月3月.xlsx 2022年3月1日 C 300 2023月3月.xlsx 2022年3月2日 D 400 2023月3月.xlsx 2022年3月2日 E 500 2023月3月.xlsx 2022年3月2日 F 600 2023月3月.xlsx 2022年3月3日 G 700 2023月3月.xlsx 2022年3月3日 H 800 2023月3月.xlsx 2022年3月3日 I 900 2022月1月.xlsx 2022年1月1日 A 100 2022月1月.xlsx 2022年1月1日 B 200 2022月1月.xlsx 2022年1月1日 C 300 2022月1月.xlsx 2022年1月2日 D 400 2022月1月.xlsx 2022年1月2日 E 500 2022月1月.xlsx 2022年1月2日 F 600 2022月1月.xlsx 2022年1月3日 G 700 2022月1月.xlsx 2022年1月3日 H 800 2022月1月.xlsx 2022年1月3日 I 900 2022月2月.xlsx 2022年2月1日 A 100 2022月2月.xlsx 2022年2月1日 B 200 2022月2月.xlsx 2022年2月1日 C 300 2022月2月.xlsx 2022年2月2日 D 400 2022月2月.xlsx 2022年2月2日 E 500 2022月2月.xlsx 2022年2月2日 F 600 2022月2月.xlsx 2022年2月3日 G 700 2022月2月.xlsx 2022年2月3日 H 800 2022月2月.xlsx 2022年2月3日 I 900 2022月3月.xlsx 2022年3月1日 A 100 2022月3月.xlsx 2022年3月1日 B 200 2022月3月.xlsx 2022年3月1日 C 300 2022月3月.xlsx 2022年3月2日 D 400 2022月3月.xlsx 2022年3月2日 E 500 2022月3月.xlsx 2022年3月2日 F 600 2022月3月.xlsx 2022年3月3日 G 700 2022月3月.xlsx 2022年3月3日 H 800 2022月3月.xlsx 2022年3月3日 I 900 簡易的に、3つのフォルダで、3つのブック、3つのシートとしておりますけども、フォルダやブック、シートが増えた場合でも同じVBAコードで実行できるかと思います。 VBAコードのポイントとしては、次の3つになります。 ①フォルダ内のサブフォルダを取得する方法 ②フォルダ内のすべてのファイルパスを取得する方法 ③複数シートからデータを取得する方法 ①と②については、次の動画が参考になるかと思います。 ua-cam.com/video/tdGqjSV11ZA/v-deo.html そして、③については、次の動画が参考になるかと思います。 ua-cam.com/video/RI2UGvt8-g4/v-deo.html 参考になればと思います（^^）
Dim FolderPath 'フォルダパスを指定 FolderPath = ThisWorkbook.Path & "\TEST" Dim FSO 'FSOを作成 Set FSO = CreateObject("Scripting.FileSystemObject") Dim A 'サブフォルダをループ For Each Folder In FSO.GetFolder(FolderPath).SubFolders 'フォルダ内のファイルをループ For Each File In FSO.GetFolder(Folder).Files Workbooks.Open File 'ブックを開く 'シートをループ For Each A In Sheets With A.Range("A1").CurrentRegion 'データを取得 .Resize(.Rows.Count - 1).Offset(1, 0).Copy ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Offset(1, 0) 'フォルダ名を取得 ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(.Rows.Count - 1) = Replace(Folder, ThisWorkbook.Path & "\TEST\", "") 'ブックパスを取得 ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(.Rows.Count - 1) = ActiveWorkbook.Name 'シート名を取得 ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(.Rows.Count - 1) = A.Name End With Next 'ブックを閉じる ActiveWorkbook.Close Next Next
'連想配列を作成 Dim Dic1, Dic2 Set Dic1 = CreateObject("Scripting.Dictionary") Set Dic2 = CreateObject("Scripting.Dictionary")
'店舗と日付のユニークなデータを作成 For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row If Dic1.exists(Cells(i, "A").Value) = False Then Dic1.Add Cells(i, "A").Value, 0 End If If Dic2.exists(Cells(i, "C").Value) = False Then Dic2.Add Cells(i, "C").Value, 0 End If Next
For i = 0 To UBound(aDate, 1) For j = 0 To UBound(Shop, 1) '日付でフィルタ Sheets("Sheet1").Range("A1").AutoFilter 3, aDate(i) '店舗でフィルタ Sheets("Sheet1").Range("A1").AutoFilter 1, Shop(j) 'フィルタ結果がある場合 If WorksheetFunction.CountA(Sheets("Sheet1").Range("A:A")) > 1 Then Sheets.Add after:=Sheets(Sheets.Count) 'シートを追加 'フィルタ結果をコピー Sheets("Sheet1").Range("A1").CurrentRegion.Copy Range("A1") ActiveSheet.Name = Shop(j) 'シート名を店舗名に変更 End If Next '新規ブックに複数店舗シートを移動 Sheets(Shop).Move '「日付」の名前を付けて保存 ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & aDate(i) ActiveWorkbook.Close 'ブックを閉じる Next
'フィルタを解除 If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If
End Sub 実行するとまず、次のようにすべてのブックのデータを1つのシートにまとめることができます。 フォルダ名 ブック名 シート名 商品 価格 A店舗 2022月1月.xlsx 2022年1月1日 A 100 A店舗 2022月1月.xlsx 2022年1月1日 B 200 A店舗 2022月1月.xlsx 2022年1月1日 C 300 A店舗 2022月1月.xlsx 2022年1月2日 D 400 A店舗 2022月1月.xlsx 2022年1月2日 E 500 A店舗 2022月1月.xlsx 2022年1月2日 F 600 ・・・ C店舗 2022月3月.xlsx 2022年3月2日 D 400 C店舗 2022月3月.xlsx 2022年3月2日 E 500 C店舗 2022月3月.xlsx 2022年3月2日 F 600 C店舗 2022月3月.xlsx 2022年3月3日 G 700 C店舗 2022月3月.xlsx 2022年3月3日 H 800 C店舗 2022月3月.xlsx 2022年3月3日 I 900 上記のデータを日付と店舗でフィルタして、店舗ごとにシートを作成して、日付ごとにファイルを作成していきます。 最後まで実行すると、次のようにマクロブックと同じ階層に、複数ブックを作成することができます。 2022年1月1日.xlsx 2022年1月2日.xlsx 2022年1月3日.xlsx 2022年2月1日.xlsx 2022年2月2日.xlsx 2022年2月3日.xlsx 2022年3月1日.xlsx 2022年3月2日.xlsx 2022年3月3日.xlsx 上記のブックには、次のようにシートが作成されます。 「A店舗」 「B店舗」 「C店舗」 そして、それぞれのシートのデータは、次のように保存されます。 ↓「A店舗」のシート フォルダ名 ブック名 シート名 商品 価格 A店舗 2022月1月.xlsx 2022年1月1日 A 100 A店舗 2022月1月.xlsx 2022年1月1日 B 200 A店舗 2022月1月.xlsx 2022年1月1日 C 300 ↓「B店舗」のシート フォルダ名 ブック名 シート名 商品 価格 B店舗 2023月1月.xlsx 2022年1月1日 A 100 B店舗 2023月1月.xlsx 2022年1月1日 B 200 B店舗 2023月1月.xlsx 2022年1月1日 C 300 ↓「C店舗」のシート フォルダ名 ブック名 シート名 商品 価格 C店舗 2022月1月.xlsx 2022年1月1日 A 100 C店舗 2022月1月.xlsx 2022年1月1日 B 200 C店舗 2022月1月.xlsx 2022年1月1日 C 300 他の日付ごとのブックも同じように、上記のように店舗ごとのシートで保存されます。 かなりいろいろなVBAコードを詰め込んだ感じです。 ポイントとしては、次の点になります。 ・サブフォルダパスの取得 ・フォルダ内のブックパスの取得 ・複数ブックをまとめる ・重複しないデータの取得 ・別シートに転記 ・複数シートを別ブックで保存 VBAコードのテクニックがかなり盛りだくさんになっています（^^;） 今回は、簡易的なデータでやってみたんですけど、フォルダ数が増えた場合や、ブック数が増えた場合、シート数が増えた場合でも、上記のVBAコードで対応できるかと思います。 参考になればと思います（^^）
コメントありがとうございます！ 本動画の最後の方法のVBAコードを少し修正すると、シート「A」のデータを取得することができます。 VBAコードは次のようになります。 Sub TEST5() Dim A, B, C Set B = ThisWorkbook.Worksheets("Sheet1") 'フォルダ内のブック名を取得 C = Dir(ThisWorkbook.Path & "\TEST\*") Do While C "" 'ブックを開く Workbooks.Open ThisWorkbook.Path & "\TEST\" & C 'データ部分を取得 With ActiveWorkbook.Worksheets("A").Range("A1").CurrentRegion A = .Rows("2:" & .Rows.Count) End With 'データを入力 B.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(UBound(A, 1), 2) = A 'ブック名を入力 B.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(UBound(A, 1)) = ActiveWorkbook.Name ActiveWorkbook.Close False 'ブックを閉じる C = Dir() '次のブック名を取得 Loop End Sub 取得先のシート名を「Sheet1」から「A」に変更しております。 参考になればと思います（^^）
コメントありがとうございます！ ご指摘の通りで、簡略型で、「.Rows」を使いました。 With .Range("A1").CurrentRegion.Offset(1,0) A=.Resize(.Rows.Count) End With というような感じで、データ部分を取得する方法が一般的かと思いますけども、OffsetとResizeで2段階で取得する形となりますので、.Rowsを使って取得する方法の方が、今回の場合は、シンプルかと思いましたので、.Rowsを使う方法で解説しました(^^) 最終的には、好みの話になるかと思いますので、書きやすいコードを選択されるといいかと思います！
複数ブックをそのまま崩さず、一つのブックにまとめる方を知りたかったので勉強になります！
テンポの良さ、詳しい解説、有り難うございます。
はじめまして。
凄いわかりやすい動画でとても勉強になりました。
申し訳ないのですが、
聞きたいことがあります。
一つのフォルダーがあり、そのフォルダーにはさらに約30個ほどのフォルダーがあります。さらにその30個のフォルダーの中には、月ごとのファイルが12個あります。さらにその12個のファイルには日にち毎の31枚のシートがあります。
その31日のシートを日にち毎に一つのファイルにまとめたいのですが、vbaで可能でしょうか。
コメントありがとうございます！
かなり実務的な内容ですね（^^）
ご質問の内容としては、次のような手順で取得できるかと思います。
・サブフォルダのフォルダパスを取得
・サブフォルダ内のファイルパスを取得
・すべてのブックをループ
・ブック内のシートをループ
・シートのデータとブック名とシート名を取得
VBAコードとしては、次のようになります。
Sub TEST1()
Dim FolderPath
'フォルダパスを指定
FolderPath = ThisWorkbook.Path & "\TEST"
Dim FSO
'FSOを作成
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim A
'サブフォルダをループ
For Each Folder In FSO.GetFolder(FolderPath).SubFolders
'フォルダ内のファイルをループ
For Each File In FSO.GetFolder(Folder).Files
Workbooks.Open File 'ブックを開く
'シートをループ
For Each A In Sheets
With A.Range("A1").CurrentRegion
'データを取得
.Resize(.Rows.Count - 1).Offset(1, 0).Copy ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
'ブックパスを取得
ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(.Rows.Count - 1) = ActiveWorkbook.Name
'シート名を取得
ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(.Rows.Count - 1) = A.Name
End With
Next
'ブックを閉じる
ActiveWorkbook.Close
Next
Next
End Sub
フォルダとブック、シート構成としては、次のように作成しております。
・トップのフォルダとして「TEST」のフォルダを作成
・「TEST」フォルダ内に「TEST1」～「TEST3」を作成
・それぞれのフォルダ内に「2022年1月.xlsx」～「2022年3月.xlsx」のブックを保存
・それぞれのブック内に「2022年1月1日」～「2022年3月」のシートを作成
・シートのデータは「商品」と「価格」のデータを保存
という構成となっております。
そして、マクロブックと同じ階層に「TEST」フォルダを保存しております。
VBAコードを実行すると、次のようにすべてのフォルダ内のすべてのブックから、すべてのシートのデータを取得することができます。
ブック名 シート名 商品 価格
2022月1月.xlsx 2022年1月1日 A 100
2022月1月.xlsx 2022年1月1日 B 200
2022月1月.xlsx 2022年1月1日 C 300
2022月1月.xlsx 2022年1月2日 D 400
2022月1月.xlsx 2022年1月2日 E 500
2022月1月.xlsx 2022年1月2日 F 600
2022月1月.xlsx 2022年1月3日 G 700
2022月1月.xlsx 2022年1月3日 H 800
2022月1月.xlsx 2022年1月3日 I 900
2022月2月.xlsx 2022年2月1日 A 100
2022月2月.xlsx 2022年2月1日 B 200
2022月2月.xlsx 2022年2月1日 C 300
2022月2月.xlsx 2022年2月2日 D 400
2022月2月.xlsx 2022年2月2日 E 500
2022月2月.xlsx 2022年2月2日 F 600
2022月2月.xlsx 2022年2月3日 G 700
2022月2月.xlsx 2022年2月3日 H 800
2022月2月.xlsx 2022年2月3日 I 900
2022月3月.xlsx 2022年3月1日 A 100
2022月3月.xlsx 2022年3月1日 B 200
2022月3月.xlsx 2022年3月1日 C 300
2022月3月.xlsx 2022年3月2日 D 400
2022月3月.xlsx 2022年3月2日 E 500
2022月3月.xlsx 2022年3月2日 F 600
2022月3月.xlsx 2022年3月3日 G 700
2022月3月.xlsx 2022年3月3日 H 800
2022月3月.xlsx 2022年3月3日 I 900
2023月1月.xlsx 2022年1月1日 A 100
2023月1月.xlsx 2022年1月1日 B 200
2023月1月.xlsx 2022年1月1日 C 300
2023月1月.xlsx 2022年1月2日 D 400
2023月1月.xlsx 2022年1月2日 E 500
2023月1月.xlsx 2022年1月2日 F 600
2023月1月.xlsx 2022年1月3日 G 700
2023月1月.xlsx 2022年1月3日 H 800
2023月1月.xlsx 2022年1月3日 I 900
2023月2月.xlsx 2022年2月1日 A 100
2023月2月.xlsx 2022年2月1日 B 200
2023月2月.xlsx 2022年2月1日 C 300
2023月2月.xlsx 2022年2月2日 D 400
2023月2月.xlsx 2022年2月2日 E 500
2023月2月.xlsx 2022年2月2日 F 600
2023月2月.xlsx 2022年2月3日 G 700
2023月2月.xlsx 2022年2月3日 H 800
2023月2月.xlsx 2022年2月3日 I 900
2023月3月.xlsx 2022年3月1日 A 100
2023月3月.xlsx 2022年3月1日 B 200
2023月3月.xlsx 2022年3月1日 C 300
2023月3月.xlsx 2022年3月2日 D 400
2023月3月.xlsx 2022年3月2日 E 500
2023月3月.xlsx 2022年3月2日 F 600
2023月3月.xlsx 2022年3月3日 G 700
2023月3月.xlsx 2022年3月3日 H 800
2023月3月.xlsx 2022年3月3日 I 900
2022月1月.xlsx 2022年1月1日 A 100
2022月1月.xlsx 2022年1月1日 B 200
2022月1月.xlsx 2022年1月1日 C 300
2022月1月.xlsx 2022年1月2日 D 400
2022月1月.xlsx 2022年1月2日 E 500
2022月1月.xlsx 2022年1月2日 F 600
2022月1月.xlsx 2022年1月3日 G 700
2022月1月.xlsx 2022年1月3日 H 800
2022月1月.xlsx 2022年1月3日 I 900
2022月2月.xlsx 2022年2月1日 A 100
2022月2月.xlsx 2022年2月1日 B 200
2022月2月.xlsx 2022年2月1日 C 300
2022月2月.xlsx 2022年2月2日 D 400
2022月2月.xlsx 2022年2月2日 E 500
2022月2月.xlsx 2022年2月2日 F 600
2022月2月.xlsx 2022年2月3日 G 700
2022月2月.xlsx 2022年2月3日 H 800
2022月2月.xlsx 2022年2月3日 I 900
2022月3月.xlsx 2022年3月1日 A 100
2022月3月.xlsx 2022年3月1日 B 200
2022月3月.xlsx 2022年3月1日 C 300
2022月3月.xlsx 2022年3月2日 D 400
2022月3月.xlsx 2022年3月2日 E 500
2022月3月.xlsx 2022年3月2日 F 600
2022月3月.xlsx 2022年3月3日 G 700
2022月3月.xlsx 2022年3月3日 H 800
2022月3月.xlsx 2022年3月3日 I 900
簡易的に、3つのフォルダで、3つのブック、3つのシートとしておりますけども、フォルダやブック、シートが増えた場合でも同じVBAコードで実行できるかと思います。
VBAコードのポイントとしては、次の3つになります。
①フォルダ内のサブフォルダを取得する方法
②フォルダ内のすべてのファイルパスを取得する方法
③複数シートからデータを取得する方法
①と②については、次の動画が参考になるかと思います。
ua-cam.com/video/tdGqjSV11ZA/v-deo.html
そして、③については、次の動画が参考になるかと思います。
ua-cam.com/video/RI2UGvt8-g4/v-deo.html
参考になればと思います（^^）
凄すぎです‼️
お忙しい中、早速のご対応
誠にありがとうございます❗️
難しいすぎますが、
やってみます❗️
本当に助かります😊
何度も本当に申し訳ございません。
質問は最後に致します。
ご迷惑をおかけし
申し訳ございません。
先程は本当にありがとうございました。
とても参考になりました！
もう一つだけ聞きたいです！
一つのシートにまとめるのではなく、
一つのファイルにまとめるvbaは可能でしょうか？
33個のフォルダー👉33個中のフォルダーの中には月ごとの12個のファイル👉12個のファイルの中は日にち毎に書かれた31枚のシート。写真付き日報など。
この各33店舗分の日にち毎に書かれたシートを
一つのファイルに日にち毎にまとめたい。（例えば、
1日のまとめたファイル（33枚のシート）
2日のまとめたファイル（33枚のシート）
‥
‥
としたい。
これはvbaで可能でしょうか？
可能でしたら
コードを教えていただきたいのですが。
ご迷惑をおかけし
誠に申し訳ございません。
@@コーギー-w5b コメントありがとうございます（^^）
下記のような感じで、データをまとめたいということかと思います。
2022年1月1日のまとめたブック（店舗ごとのシート）
2022年1月2日のまとめたブック（店舗ごとのシート）
2022年1月3日のまとめたブック（店舗ごとのシート）
・・・
2022年12月29日のまとめたブック（店舗ごとのシート）
2022年12月30日のまとめたブック（店舗ごとのシート）
2022年12月31日のまとめたブック（店舗ごとのシート）
簡易データとして、下記のデータを用意しました。
フォルダとして、下記の3つのフォルダを作成しました。
A店舗
B店舗
C店舗
上記フォルダは、「TEST」というフォルダにまとめて保存しています。
「TEST」フォルダは、マクロブックと同じ階層に保存しています。
上記フォルダには、下記の3つのブックが保存されています。
2022年1月.xlsx
2022年2月.xlsx
2022年3月.xlsx
上記ブックには、下記のシートが作成されています。
「2022年1月1日」のシート
「2022年1月2日」のシート
「2022年1月3日」のシート
そして、上記のそれぞれのシートには、簡易的に次のデータを保存しました。
商品 値段
A 100
B 200
C 300
VBAコードを実行する手順としては、次のようになります。
■第1パート
・複数フォルダパスを取得してループ
・複数フォルダの複数ファイルパスを取得してループ
・複数ファイルパスの複数シートのデータをループして取得
・すべてのブックからデータの取得完了
■第2パート
・日付ごとにデータをフィルタ
・店舗ごとにフィルタして別シートに転記
・店舗ごとのシートを別ブックに移動
・別ブックを名前を付けて保存
・別ブックを閉じる
・日付と店舗をすべてループ
VBAコードは、次のようになります。
Sub TEST2()
Dim FolderPath
'フォルダパスを指定
FolderPath = ThisWorkbook.Path & "\TEST"
Dim FSO
'FSOを作成
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim A
'サブフォルダをループ
For Each Folder In FSO.GetFolder(FolderPath).SubFolders
'フォルダ内のファイルをループ
For Each File In FSO.GetFolder(Folder).Files
Workbooks.Open File 'ブックを開く
'シートをループ
For Each A In Sheets
With A.Range("A1").CurrentRegion
'データを取得
.Resize(.Rows.Count - 1).Offset(1, 0).Copy ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Offset(1, 0)
'フォルダ名を取得
ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(.Rows.Count - 1) = Replace(Folder, ThisWorkbook.Path & "\TEST\", "")
'ブックパスを取得
ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(.Rows.Count - 1) = ActiveWorkbook.Name
'シート名を取得
ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(.Rows.Count - 1) = A.Name
End With
Next
'ブックを閉じる
ActiveWorkbook.Close
Next
Next
'連想配列を作成
Dim Dic1, Dic2
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
'店舗と日付のユニークなデータを作成
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Dic1.exists(Cells(i, "A").Value) = False Then
Dic1.Add Cells(i, "A").Value, 0
End If
If Dic2.exists(Cells(i, "C").Value) = False Then
Dic2.Add Cells(i, "C").Value, 0
End If
Next
Dim Shop, aDate
Shop = Dic1.keys '店舗のユニークデータ
aDate = Dic2.keys '日付のユニークデータ
For i = 0 To UBound(aDate, 1)
For j = 0 To UBound(Shop, 1)
'日付でフィルタ
Sheets("Sheet1").Range("A1").AutoFilter 3, aDate(i)
'店舗でフィルタ
Sheets("Sheet1").Range("A1").AutoFilter 1, Shop(j)
'フィルタ結果がある場合
If WorksheetFunction.CountA(Sheets("Sheet1").Range("A:A")) > 1 Then
Sheets.Add after:=Sheets(Sheets.Count) 'シートを追加
'フィルタ結果をコピー
Sheets("Sheet1").Range("A1").CurrentRegion.Copy Range("A1")
ActiveSheet.Name = Shop(j) 'シート名を店舗名に変更
End If
Next
'新規ブックに複数店舗シートを移動
Sheets(Shop).Move
'「日付」の名前を付けて保存
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & aDate(i)
ActiveWorkbook.Close 'ブックを閉じる
Next
'フィルタを解除
If ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
End Sub
実行するとまず、次のようにすべてのブックのデータを1つのシートにまとめることができます。
フォルダ名 ブック名 シート名 商品 価格
A店舗 2022月1月.xlsx 2022年1月1日 A 100
A店舗 2022月1月.xlsx 2022年1月1日 B 200
A店舗 2022月1月.xlsx 2022年1月1日 C 300
A店舗 2022月1月.xlsx 2022年1月2日 D 400
A店舗 2022月1月.xlsx 2022年1月2日 E 500
A店舗 2022月1月.xlsx 2022年1月2日 F 600
・・・
C店舗 2022月3月.xlsx 2022年3月2日 D 400
C店舗 2022月3月.xlsx 2022年3月2日 E 500
C店舗 2022月3月.xlsx 2022年3月2日 F 600
C店舗 2022月3月.xlsx 2022年3月3日 G 700
C店舗 2022月3月.xlsx 2022年3月3日 H 800
C店舗 2022月3月.xlsx 2022年3月3日 I 900
上記のデータを日付と店舗でフィルタして、店舗ごとにシートを作成して、日付ごとにファイルを作成していきます。
最後まで実行すると、次のようにマクロブックと同じ階層に、複数ブックを作成することができます。
2022年1月1日.xlsx
2022年1月2日.xlsx
2022年1月3日.xlsx
2022年2月1日.xlsx
2022年2月2日.xlsx
2022年2月3日.xlsx
2022年3月1日.xlsx
2022年3月2日.xlsx
2022年3月3日.xlsx
上記のブックには、次のようにシートが作成されます。
「A店舗」
「B店舗」
「C店舗」
そして、それぞれのシートのデータは、次のように保存されます。
↓「A店舗」のシート
フォルダ名 ブック名 シート名 商品 価格
A店舗 2022月1月.xlsx 2022年1月1日 A 100
A店舗 2022月1月.xlsx 2022年1月1日 B 200
A店舗 2022月1月.xlsx 2022年1月1日 C 300
↓「B店舗」のシート
フォルダ名 ブック名 シート名 商品 価格
B店舗 2023月1月.xlsx 2022年1月1日 A 100
B店舗 2023月1月.xlsx 2022年1月1日 B 200
B店舗 2023月1月.xlsx 2022年1月1日 C 300
↓「C店舗」のシート
フォルダ名 ブック名 シート名 商品 価格
C店舗 2022月1月.xlsx 2022年1月1日 A 100
C店舗 2022月1月.xlsx 2022年1月1日 B 200
C店舗 2022月1月.xlsx 2022年1月1日 C 300
他の日付ごとのブックも同じように、上記のように店舗ごとのシートで保存されます。
かなりいろいろなVBAコードを詰め込んだ感じです。
ポイントとしては、次の点になります。
・サブフォルダパスの取得
・フォルダ内のブックパスの取得
・複数ブックをまとめる
・重複しないデータの取得
・別シートに転記
・複数シートを別ブックで保存
VBAコードのテクニックがかなり盛りだくさんになっています（^^;）
今回は、簡易的なデータでやってみたんですけど、フォルダ数が増えた場合や、ブック数が増えた場合、シート数が増えた場合でも、上記のVBAコードで対応できるかと思います。
参考になればと思います（^^）
大体IT様
この度はお忙しい中にもかかわらず
何度もコードを作成していただき
誠にありがとうございます。
凄すぎて、もう感動です‼️
本当に尊敬します‼️
私も自分のちからだけで
できるようになりたいです。
まだ作成してませんが、
帰宅したら、速攻やってみます！
本当にありがとうございました‼️
初めまして
フォルダ内に名称バラバラの複数ブックがありその中にA,B,CのシートがあってAという名称のシートだけを取り出して一つのシートにまとめることは可能でしょうか？
コメントありがとうございます！
本動画の最後の方法のVBAコードを少し修正すると、シート「A」のデータを取得することができます。
VBAコードは次のようになります。
Sub TEST5()
Dim A, B, C
Set B = ThisWorkbook.Worksheets("Sheet1")
'フォルダ内のブック名を取得
C = Dir(ThisWorkbook.Path & "\TEST\*")
Do While C ""
'ブックを開く
Workbooks.Open ThisWorkbook.Path & "\TEST\" & C
'データ部分を取得
With ActiveWorkbook.Worksheets("A").Range("A1").CurrentRegion
A = .Rows("2:" & .Rows.Count)
End With
'データを入力
B.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(UBound(A, 1), 2) = A
'ブック名を入力
B.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(UBound(A, 1)) = ActiveWorkbook.Name
ActiveWorkbook.Close False 'ブックを閉じる
C = Dir() '次のブック名を取得
Loop
End Sub
取得先のシート名を「Sheet1」から「A」に変更しております。
参考になればと思います（^^）
返信ありがとうございます。
全てのシートを一つにまとめると
勘違いしてました。動画の通りでも
問題なく動きました。
ただ、コピーする際シートの名前の定義
のダイアログ？を消さなくちゃならなく
なり削除するコードを追加で入れたら
少し動作が重くなってしまいました。
このやり方で、割とデータ数あるシートを持った5つのブックを回したら重すぎて動かなくなりました。。。
ファイル開いたあと、シートの選択もFor eachで入れてるのですが、それが原因でしょうか？
配列変数を使っているのに早く処理できるはずですよね？😢
コメントありがとうございます！
解決する糸口としましては、
解決案①
取り込み先のブックが大きい場合に、取り込み先のブックを開いた状態で、VBAコードを実行すると、PCの性能によっては、動作が止まってしまうことがあります。
ですので、一旦、取り込み先のブックから必要なデータのみを、取り込み元のブックに転記して、取り込み先のブックを「閉じた後」に、操作すると動作するかもしれません。
解決案2
「シートの選択」と記載がありましたので、もしかすると、「Select」や「Active」のVBAコードを使用しているかと思いました。
「Select」や「Active」はVBA処理の中でも重い操作になりなります。
ですので、シート操作を「Sheets().」のように指定して、シートの選択を避けるVBAコードに変更することで、VBAコードが止まってしまうのを避けることができるかもしれません。
参考になればと思います（^^）
こんばんわ
上記、動画を視聴し同じようにコードを書いているのですが、’シートをコピー取得時に「実行時エラー’9’ インデックスが有効範囲にありません。」のエラーが出ます。
原因がわからず挫折しています。ご教授をお願いします。
コードTEST3やTEST4で、変数Aに .Rows("2:" & .Rows.Count)と、あえて行を入れてますが、「ActiveWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion」に対してoffsetとresizeを使わないデータ部のみの抽出の簡略形という理解で良いでしょうか？
コメントありがとうございます！
ご指摘の通りで、簡略型で、「.Rows」を使いました。
With .Range("A1").CurrentRegion.Offset(1,0)
A=.Resize(.Rows.Count)
End With
というような感じで、データ部分を取得する方法が一般的かと思いますけども、OffsetとResizeで2段階で取得する形となりますので、.Rowsを使って取得する方法の方が、今回の場合は、シンプルかと思いましたので、.Rowsを使う方法で解説しました(^^)
最終的には、好みの話になるかと思いますので、書きやすいコードを選択されるといいかと思います！
@@IT-gx8sf ありがとうございました
自分用メモ 11:10