セルの値からファイルを複数作りたい

エクセルのファイルがあります。
ファイルには複数のシートが入っています。（50シート）

複数のシートの中で、別ブックで保管したいシートのR1セルには、ファイル名を入れています。

R1セルに入っている値
総務部_aaaaa.xlsx
総務部_abbbb.xlsx
経理部_accaa.xlsx
営業部_ddddd.xlsx

ファイルはディスクトップのテストフォルダに保管したいと思っています。
C:\Users\aaa\Desktop\TEST\

R1セルにはいっている値をファイル名にして区分けするマクロはどのようにしたら良いのでしょうか。

No.2 ベストアンサー 回答者： fujillin 回答日時： 2022/10/06 17:15

こんにちは

＞マクロはどのようにしたら良いのでしょうか。
すでに回答にあるように、作るしかありません。
「R1セルを参照して空白でなかったら、指定のディレクトリに保存する」というものを、各シートで繰り返せば良いでしょう。

また、ご質問文には不明な点が多々あります。
例えば、
　・複数シートに同じ保存先が指定されている可能性の有無
　・保存先の指定がおかしな文字になっている場合の処置
　・フォルダに既に同名のファイルが存在している場合の処置
などなど・・・

以下は、不明なケースに対して勝手に適当な処理を加えてあるので、相当に冗長になっていますが（多分、倍くらいの長さかも？）、ご参考までに。

Sub Q_13175734()
Dim Dic, v, p As String
Dim i As Long, j As Long
Const b = "\/:;*?""<>|"

' 以下二行の「CO」の文字を下記にあるように修正のこと！！！
Set Dic = CO("Scripting.Dictionary")
p = CO("WScript.Shell").SpecialFolders("Desktop") & "\TEST\"
If Dir(p, 16) = "" Then MkDir p

For i = 1 To Worksheets.Count
v = Worksheets(i).Range("R1").Text
If Right(v, 5) = ".xlsx" Then v = Left(v, Len(v) - 5)
For j = 1 To Len(b)
v = Replace(v, Mid(b, j, 1), "X")
Next j
If v <> "" Then
If Dic.Exists(v) Then
Dic(v) = Dic(v) & "|" & Worksheets(i).Name
Else
Dic.Add v, Worksheets(i).Name
End If
End If
Next i

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each v In Dic
Worksheets(Split(Dic(v), "|")).Copy
With ActiveWorkbook
.SaveAs p & v & ".xlsx"
.Close False
End With
Next v
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


※ 普通にコードを記述すると、投稿時にはじかれてしまうようです。
　コメントの下二行の「CO」の部分を以下のように書き換えてください。
　　CO　→　CreateObject

こっちの原因を探して対応する方が、回答より時間がかかってしまった（汗

この回答へのお礼

ありがとうございます、
おかげさまでやりたいことができました。
不明点の解決策まで作成いただき、ありがとうございました。

お礼日時：2022/10/07 11:15

No.1 回答者： Qchan1962 回答日時： 2022/10/06 13:32

こんにちは

＞R1セルにはいっている値をファイル名にして区分けするマクロはどのようにしたら良いのでしょうか。

ご質問者様は、マクロの書き方を知りたいですか？それとも結果が欲しいのでしょうか？

前者なら、先ずは自分で作りましょう
（ループ、制御系のコードを除けば　If文を入れても5行くらいで出来ますのでトライしてみてはいかがでしょう）

下記で検索すればそのまま使えるコードが見つかります
内容を検証して必要なコードを1つにまとめます

①「VBA シートを別ブックとして保存する」
②「VBA ブック内のすべてのワークシートで同じ処理を行う」
③「VBA 空白以外のセル」
などで調べる

調べて作ったコードで上手くいかなかった時は書いたコードを添えて
再質問してみて・・
（プロシージャを書く方がこんな回答より簡単ですが前者であることを期待しています）

すでに書いているコードがあれば補足に示すと良いかもです

この回答へのお礼

ありがとうございます

お礼日時：2022/10/07 11:15