教えて下さい！VBAで複数Excelを1つのブックにまとめたいです。

はじめまして。VBA初心者のため、お知恵を貸してください。

1つのフォルダの中に、いちご10月、いちご11月、みかん9月、なし8月、、という形で、月別のフルーツの売り上げデータが複数あります。

このExcelを、フルーツ別に1つのブックにまとめたいのですが、どのようなマクロにすればよいでしょうか。→例　いちご売上高　というExcelに、10月、11月というシートがついているイメージ

1、まとめたエクセルには、フルーツ名と売上高(例　いちご売上高.xlsx)というファイル名にしたいです。
2、月別のExcelに、シートは1つだけです。(月がシート名。例　10月)
3、フルーツによって、売上がない月もあります。

Excelの数が多く、手作業に時間がかかってしまうので
マクロでの作業に変更したいです。

よろしくお願いします。。

No.1 ベストアンサー 回答者： 河内のおやじ 回答日時： 2023/09/04 09:33

Sub フルーツ別にExcelファイルを作成()

Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim LastRow As Long
Dim FruitName As String
Dim DestWorkbook As Workbook
Dim SourceWorkbook As Workbook

' 作業するフォルダのパスを指定します。必要に応じて変更してください。
Dim FolderPath As String
FolderPath = "C:\YourFolderPath\"

' フォルダ内のファイルを処理します。
Dim FileName As String
FileName = Dir(FolderPath & "*.xlsx")

' ファイルが存在する限りループします。
Do While FileName <> ""
' ファイルを開きます。
Set SourceWorkbook = Workbooks.Open(FolderPath & FileName)
' ファイル名からフルーツ名を抽出します。
FruitName = Left(FileName, InStr(FileName, "売上高") - 1)

' フルーツ名.xlsxの新しいブックを作成します。
Set DestWorkbook = Workbooks.Add
' 新しいブックにシートを1つ追加します。
Set wsDest = DestWorkbook.Sheets(1)

' シート名をフルーツ名に設定します。
wsDest.Name = FruitName

' ソースブックのデータをコピーして貼り付けます。
Set wsSource = SourceWorkbook.Sheets(1)
LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
wsSource.Range("A1:B" & LastRow).Copy wsDest.Range("A1")

' ソースブックを閉じて、次のファイルに進みます。
SourceWorkbook.Close SaveChanges:=False
FileName = Dir
Loop

' ファイル保存ダイアログを表示して、フルーツ別のExcelファイルを保存します。
Dim SavePath As String
SavePath = Application.GetSaveAsFilename("フルーツ別売上高.xlsx", FileFilter:="Excelファイル (*.xlsx), *.xlsx")

If SavePath <> "False" Then
DestWorkbook.SaveAs SavePath
End If

' 新しいブックを閉じます。
DestWorkbook.Close SaveChanges:=False

End Sub

この回答へのお礼

回答いただき、ありがとうございます。

早速実行してみたところ、
DestWorkbook.SaveAs SavePath

のところで、止まってしまい、「オブジェクト変数又はwithブロック変数が設定されていません」というメッセージがでました。
全然分かっておらず、、、、、大変申し訳ないのですが、どのように対応すればよいでしょうか。

お礼日時：2023/09/04 11:10

No.3 回答者： tatsumaru77 回答日時： 2023/09/05 10:51

不明点です。

１．ファイルのフルーツ名の末尾に数字が付くことがありますか。
例として、みかん112月.xlsx　の場合、
みかん1の12月分と判断できますが、
それを許すと、みかん11月.xlsxは、みかん1の1月分なのか、みかんの11月分なのかの判断ができなくなります。
従って、フルーツ名の末尾に数字が付くことがないことが保証されていれば、実現可能です。


２．ファイルの件数はおよそ何件でしょうか。
　フルーツの件数が約40件だとすると、12か月分なので、最大40×12=480件
　およそ、500件程度かと想定しますが、実際のところは、どのくらいあるのでしょうか。

３．○○売上高.xlsxのシートの並びは、どのようにしますか、
左から、
1案：1月、2月、3月、4月、・・・・11月、12月
2案：4月、5月、・・・・11月、12月、1月、2月、3月
が考えられます。2案は4月が年度開始月の場合に採用されることが多いです。

この回答へのお礼

ご回答ありがとうございます！
不明点が多く、申し訳ありません。また、返信が遅くなり申し訳ありませんでした。

ご確認いただいた点ですが
1、フルーツ名の後ろに数字がつくことはありません。
2、ファイル件数は、１ヶ月20程度です。
3.シートの並び順は、二案の４月はじまりとなります。

と、なります。

お礼日時：2023/09/14 10:44

No.2 回答者： fujillin 回答日時： 2023/09/04 16:47

こんにちは

不明点が多すぎるので、とてもコードにはできませんが、以下に大雑把な考え方を・・
同時並行で処理する方法も考えられますが、ややこしいと思いますので、（若干効率は悪いですが）順にひとつずつ処理する方法にしてあります。
ご参考までに。

1）まず、指定フォルダ内のフルーツ名をDictionaryなどを利用してリストアップします。
（エクセルなら、シートに全数リストアップしてから「重複を削除」してもよいです）
1-1）指定フォルダ内をDir関数やFSOを用いて、「.xlsx」ファイルを順に走査
　　（.xlsm等も含むのかは不明）
1-2）ファイル名が「xxx売上高.xlsx」のようなものは対象とせずスキップ
1-3）ファイル名の「11月」等より前の部分を取得
　（月の数字が全角なのか半角なのか、あるいは混在なのか不明）
　（InStr関数や正規表現で抜き出しできると思います）
1-4）dictionaryに登録することで、一意にする。
　　あるいは、シートにリストして「重複を削除」
※ 以上で、フォルダ内にあるフルーツ名のリストを作成できます。

※ 常に新規で作成するとしてよいのか、月別ファイルを追加して再実行する可能性があるのか等々不明ですが、一応、以下は後者として考えてあります。
※ 「xxx売上高.xlsx」ブックにすでに対象月が存在する場合にどうするのかも不明ですが、上書きしてよいものと仮定しました。

2）フルーツ名リストに従って、順にフルーツ毎に以下の処理を行う。
2-1）「フルーツ名売上高.xlsx」が存在するかDIR関数等で調べ、
　　存在すればブックをOPEN、なければ新規作成する。
2-2）フォルダ内の「フルーツ名*.xlsx」に該当するファイルを順に処理
2-3）ファイル名が「フルーツ名売上高.xlsx」の場合はそのファイルはスキップ
2-4）ファイル名から「フルーツ名」および「.xlsx」を削除したものを作成
　（月名部分に、シート名として使えない文字があるのか不明ですが、存在する可能性があるのなら、削除したり「_」などに置き換えるなどが必要）
2-5）上記で得られる「月名」のシートが存在するか調べる。
　　存在しなければ、新規にシートを作成
2-6）処理中のシート全体を「月名」シートにコピペする
2-7）処理中のファイルを閉じて次のファイルへ
　　（該当ファイルがなくなるまで続ける）
2-8）「フルーツ名売上高.xlsx」を保存し、次のフルーツ名の処理へ
※ 2）の処理をフルーツ名毎に繰り返すことで、全体の処理ができるものと思います。


※ 一気に全部を作成しようとすると大変だと思いますが、部分部分に区切って順に動作を確認しながら作成してゆくことで、完成できるものと想像します。

この回答へのお礼

ご回答ありがとうございます。
不明点が多く、申し訳ありません。
ファイル名ですが、月は半角でした。
まだまだ勉強不足なので、少しずつ区切って考えてみます。

お礼日時：2023/09/04 18:40