【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。

皆様、いつもお世話になっております。
下記記述の構文追加し、下記①の処理を行いたいのですが、ご教示頂けませんでしょうか。
未熟者ですので、問い合わせ等にお時間をいただくかもしれませんが、よろしくお願いいたします。
可能でしたら前回ご協力いただきましたQchan1962様に続きをお願いします、他の方もよろしくお願いします。
追加(記述を追加)したい処理内容。
下記マクロで出来た全部のファイルを①のフォルダに保存する処理。
① 「C:\Users\suzuko_atsushi\Desktop\Private\納期回答\納期回答保管」というフォルダに指定して保存。

-------------------------------------------------------------------------------------------------------
Sub Sample()

Dim MacroB As Worksheet 'このブックのシート
Dim Wb_Data As Workbook '1. 分割元ブック
Dim Wb_new As Workbook '分割データ保存ブック
Dim Ws As String '2. 分割元シート名
Dim Path As String '3. 分割データ保存先
Dim C_Group As String '4. グループ対象列
Dim GroupName As String 'グループ名（ブック名）
Dim C_Copy As String '5. コピーデータ右端列
Dim YMD As String '6. 保存ブック日付の表示形式
Dim PSW As String '7. 読み取りパスワード
Dim R_Data As Integer 'データの行番号
Dim Ko As Integer 'グループの件数


Set MacroB = ThisWorkbook.Worksheets(1) 'このブックのシート
Set Wb_Data = Workbooks(MacroB.Range("C11").Value) '分割元のブック名
Ws = MacroB.Range("C12")
Path = MacroB.Range("C13") & "\"
C_Group = MacroB.Range("C14")
C_Copy = MacroB.Range("C15")
YMD = MacroB.Range("C16")
PSW = MacroB.Range("C17")

If YMD = "" Then
YMD = ""
Else
YMD = Format(Date, YMD)
End If

R_Data = 2 'データの開始行

Application.ScreenUpdating = False
Do
Wb_Data.Activate
Worksheets(Ws).Range(Cells(1, 1), Cells(1, C_Copy)).Copy '1行目の項目名コピー
Workbooks.Add
ActiveSheet.Paste Range("A1") '新規ブックに貼り付け
Set Wb_new = ActiveWorkbook

Wb_Data.Activate
GroupName = Cells(R_Data, C_Group)
Ko = WorksheetFunction.CountIf(Columns(C_Group), GroupName) 'グループの件数を算出

Range(Cells(R_Data, "A"), Cells(R_Data + Ko - 1, C_Copy)).Copy 'グループ件数分コピー
Wb_new.Activate
ActiveSheet.Paste Range("A2") '新規ブック項目の下に貼り付け
ActiveSheet.Columns.AutoFit
ActiveSheet.UsedRange.Borders.LineStyle = True
Range("D2").Select
ActiveWindow.FreezePanes = True
Dim myname As String '条件不明
If ActiveSheet.Range("A2") <> "" Then
myname = ActiveSheet.Range("A2")
End If

Wb_new.SaveAs Filename:=Path & " ■" & GroupName & " 注残納期回答依頼リスト" & YMD & ".xlsx", _
Password:=PSW '指定したフォルダーに保存
Wb_new.Close

R_Data = R_Data + Ko

Loop While Cells(R_Data, C_Group) <> ""

MsgBox "完了！"

Application.ScreenUpdating = True

End Sub

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2022/08/25 11:40

こんにちは

＞可能でしたら前回ご協力いただきましたQchan1962様に続きをお願いします、他の方もよろしくお願いします

良く読むと特定の人への指名ではないのは分かりますし、お気持ちも理解する所ですが、回答者を指名しているように受け取れる書き方は良い書き方ではありません

本題
使用されているコードを実行した結果はC13セルに書かれているパス
（フォルダー）に保存されているのではないでしょうか？

安直に保存先を複数にするのであれば　Wb_new.SaveAs　を　対象ブックを閉じる前に　保存先パスを変えてもう一度実行すれば良い事になります

Wb_new.SaveAs Filename:=Path & " ■" & GroupName & " 注残納期回答依頼リスト" & YMD & ".xlsx", _
Password:=PSW '指定したフォルダーに保存（既存）

Wb_new.SaveAs Filename:=C:\Users\suzuko_atsushi\Desktop\Private\納期回答\納期回答保管\ & " ■" & GroupName & " 注残納期回答依頼リスト" & YMD & ".xlsx", _
Password:=PSW '指定したフォルダーに保存
Wb_new.Close　'閉じる

フォルダパスは既存と同じように変数に代入して使う事も出来ます

Dim archivePath As String '記録用フォルダ
archivePath = "C:\Users\suzuko_atsushi\Desktop\Private\納期回答\納期回答保管\"
Wb_new.SaveAs FileName:=archivePath _
& " ■" & GroupName & " 注残納期回答依頼リスト" & YMD & ".xlsx", _
Password:=PSW '記録用フォルダに保存

気になるところ
ご質問部分のみを回答したコードを整理せずに繋ぎ合わせて行くと不要な部分が残ったりしますね
Dim myname As String '条件不明
If ActiveSheet.Range("A2") <> "" Then
myname = ActiveSheet.Range("A2")
End If
の部分は、掲示コードを省略していないのであれば、現行では不要な部分ですね。一度、整理をされる方が良いと思います

変数への代入にセルの値を活用するのは良いと思いますが、
課題としてエラーや誤作動を防ぐ為、誤入力などを防止する必要があると思います（すでにされているかも知れませんが）
注釈を入れたり、セル入力を入力規則リストなどで制限しないのであれば、
マクロ実行時にチェックする必要があると思います

No.1 回答者： fujillin 回答日時： 2022/08/24 21:05

こんばんは

以下でわからないようなら、ご指名の方の回答をお待ちください。
https://docs.microsoft.com/ja-jp/office/vba/api/ …

この回答へのお礼

こんばんは。早速のご連絡ありがとうございます。
参考にさせていただきます。

お礼日時：2022/08/24 21:07