saveas メソッドは失敗しました workbookオブジェクト

前提・実現したいこと

はじめまして、エラーの避け方について教えてください

現在リストのIDごとに別ブックを作るVBAを作成しています。
IDがひとつの場合はうまくいきますが、２つ以上だと同じ場所でエラーが出てしまいます。

調べたところいくつか解決法がありましたが、どれもうまくいきません。

発生している問題・エラーメッセージ

saveas メソッドは失敗しました workbookオブジェクト

該当のソースコード

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 C_Copy As String    '5. コピーデータ右端列
Dim R_Data As Integer    'データの行番号
Dim Ko As Integer    'グループの件数

Set MacroB = Workbooks("作成マクロ.xlsm").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")

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
Ko = WorksheetFunction.CountIf(Columns(C_Group), Cells(R_Data, C_Group))    'グループの件数を算出

Range(Cells(R_Data, "A"), Cells(R_Data + Ko - 1, C_Copy)).Copy    'グループ件数分コピー
Wb_new.Activate
ActiveSheet.Paste Range("A2")    '新規ブック項目の下に貼り付け

     Wb_new.SaveAs Filename:=Path & Cells(2, C_Group) & "_" & Cells(2, 2) & ".xlsx", FileFormat:=1
↑ここで『saveas メソッドは失敗しました workbookオブジェクト』がでます

'指定したフォルダーに保存
Wb_new.Close

R_Data = R_Data + Ko

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

MsgBox "完了！"

Application.ScreenUpdating = True

End Sub

試したこと

・, FileFormat:=1 の追加、削除を行いましたが
どうしても重複が複数あるときに同じことが起こります。

・エクセルの再起動
・変数宣言を強制するにチェック