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

こちらで質問して解決したのですが、新たな課題が出てきてしまいました。

・前回の質問
セルの値からファイルを複数作ることができました。

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

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

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

R1セルにはいっている値をファイル名にして区分けする下記コードを教えていただきました。

・今回の質問
既存のマクロエクセルブックには
sheet1とsheet2があり、こちらも複数シート作成の際にシートをコピーして
結果すべてのシートに保管したいです。



下記
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

ご教授いただければ幸いです。
宜しくお願い致します。

No.3 ベストアンサー 回答者： fujillin 回答日時： 2022/10/11 16:40

No2です。

＞などとやってみたのですが、うまくいきませんでした・・・
何をやっているのかを理解できないで、マクロを使うのは危険だと思いますよ。
単なるブラックボックスになってしまうので、結果が違っていても気が付かない可能性が高いですし、ごく簡単な修正をしようにもお手上げになりますので。
その点、手作業なら多少の時間はかかるにしても、やりたい通りにできます。


なお、No2の回答の意味は、以下の内容です。
　Worksheets(Split("Sheet1|Sheet2|" & Dic(v), "|")).Copy

この回答へのお礼

No２様
＞何をやっているのかを理解できないで、マクロを使うのは危険だと思いますよ。
本当におっしゃる通りです。
＞追加したいシート名を「｜」区切りで連結して
の部分を今日１日試行錯誤しておりましたが、うまくいかず、
教えていただいたコードでやりたいことができました。

色々教えていただき、ありがとうございます。

お礼日時：2022/10/11 17:10

No.2 回答者： fujillin 回答日時： 2022/10/09 10:28

No1です

読み直してみたら、「既存のマクロエクセルブック」というのは同じブックのことでしょうか？

その場合は、シートの重複等はないので、新規ブック作成の際にまとめてシートをコピーすればよいです。
コピー対象に、追加したいシート名を「｜」区切りで連結しておけば良いです。

この回答へのお礼

＞読み直してみたら、「既存のマクロエクセルブック」というのは同じブックのことでしょうか？
おっしゃる通り、教えていただいたコードがかかれているブックです。

＞追加したいシート名を「｜」区切りで連結しておけば良いです。
既回答の、後半の方の
Worksheets(Split(Dic(v), "|")).Copy
に連結して
＞Worksheets(Split(Dic(v), "|"|"sheet1")).Copy
などとやってみたのですが、うまくいきませんでした・・・無知で申し訳ありませんが、またご教授いただければ幸いです。

お礼日時：2022/10/11 08:55

No.1 回答者： fujillin 回答日時： 2022/10/07 16:48

こんにちは

前回回答者です。

＞既存のマクロエクセルブックには
既存のブックというのがどこにあるのかもわからない上に、

＞複数シート作成の際にシートをコピーして
＞結果すべてのシートに保管したいです。
別ブックからシートをコピーする際には、シート名が重複する可能性があります。
その場合にどうするのかも不明ですね。

などなどがあるため、今回はコードにもしようがありません。
ですので、修正箇所と方法のみの回答になります。

既回答の、後半の方の
＞Worksheets(Split(Dic(v), "|")).Copy
で、対象となるシート（複数可）を新しいブックにコピーしています。
現状は、その後すぐに「名前を付けて保存」(=SaveAs)していますが、その前に、ブックにご質問のシートを追加する処理をいれれば良いでしょう。

この回答へのお礼

お礼が遅くなってしまい、申し訳ありません。
前回も今回もご回答いただきありがとうございます。
確認し、
＞Worksheets(Split(Dic(v), "|")).Copy
を付けてみます！！

お礼日時：2022/10/11 08:36