エクセルで特定のシートだけを別ファイル名で保存

質問

いつもお世話になっております。
作業用の既存Bookの特定のシート（提出用）だけを、別のファイル名で保存したい。
保存先フォルダーはフルパスで指定して、ファイル名は当該シートの指定セルの内容で、xlsx形式で保存したいのです。

過去の質問に似たようなケースの回答があるのですが、悲しいかな使いこなせないレベルなのでHELPさせていただきます。

回答No.9

HohoPapa

ごめんなさい、直します。
Sub Test13()

　Dim NewBookName As String
　Dim TgCell As Range

　'保存先ファイル名（フルパス）を組立
　'指定シートだけで新たなブックを生成
　'新たなブックを仮保存
　With ThisWorkbook.Sheets("提出用")
　　'NewBookName = _
　　　"\\Srv01\原紙" & "\" & Range("F6") & Range("A1").Value & ".xlsx"
　　NewBookName = _
　　　 Range("F6") & Range("A1").Value & ".xlsx"
　　.Copy
　　ActiveWorkbook.SaveAs Filename:=NewBookName
　End With

　'新たなブックの関数式を値に書き換え
　With Workbooks(NewBookName).Sheets("提出用")
　　.Unprotect
　　For Each TgCell In .UsedRange　　'<==修正後
　　　TgCell.Value = TgCell.Value
　　Next TgCell
　End With

　'新たなブックを最終保存して閉じる
　Workbooks(NewBookName).Save
　Workbooks(NewBookName).Close

End Sub

お礼

いつもお世話になっております。

修正版までいただき恐縮です。
が何度やっても非常に時間がかかり最後はエクセルが止まってしまいます。
（あるいはあっさり見慣れた「オブジェクトエラー」と表示されますが、これは前回の試行時で自動で作られるBookが表示されている場合だと思います。（今回混乱した原因）

そこでF8でステップを追ってみると下記の2行を行ったり来たりします。
念のため、かなりしつこくF8を押してみましたが行ったり来たりを繰り返しました。

TgCell.Value = TgCell.Value
Next TgCell

今回はNo7さんのg回答で解決できました。
検証が遅れたため、お手数をおかけしてしまいました。

補足

今回は最初にご回答いただいたkkkkkmさんのご回答で解決できました。

今回大きくトラブった原因は下記の２点。
１．いったん失敗した後の試行では前回のBookが残っているのでエラーとなる。
２．シートには保存時に自動で保護かかるようにマクロが設定されているのでコピペの貼り付時に、シートの保護の状況で結果が変わる。これが最大の原因。

そこで、念のためにご回答の改良版を最後に試してみましたが、やはり結果は同じ個所でエラーとなりました。

恐らくまだ当方に見落としがある思われますが今回は疲れたのでここまででご容赦！！

ありがとうございました。