宏从一个位置删除文件，然后保存在其他位置？

Question

我创建了一个宏来将工作表保存到特定位置（见下文）：     Sub Savefileas（）     Dim Ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ws.Unprotect Password:="Spiralbevel1"
ws.EnableSelection = xlNoSelection
ws.Protect Password:="Spiralbevel1", DrawingObjects:=False, Contents:=True, Scenarios:=True
Next ws

Dim ThisFile As String
Dim varResult As Variant
ThisFile = Range("B4").Value
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Macro Enabled Workbook" & "(*.xlsm), *xlsm", Title:=ThisFile & ".xlsm", InitialFileName:="G:\New Manufacturing Engineering\Gear Shop\Spiral Bevel\Miscellaneous\Stock Removal Test File\Stock Removals with Errors\ " & ThisFile & ".xlsm")
With ActiveWorkbook
    On Error GoTo message
    .SaveAs varResult & ".xlsm", FileFormat:=52
    Exit Sub
message:
    MsgBox "There is an error"
End With
End Sub

需要审核此工作表，然后使用此宏将其保存到其他位置：

Sub Savefileas()
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ws.Unprotect Password:="Spiralbevel1"
ws.EnableSelection = xlNoSelection
ws.Protect Password:="Spiralbevel1", DrawingObjects:=True, Contents:=True, Scenarios:=True
Next ws

Dim ThisFile As String
Dim varResult As Variant
ThisFolder = Range("B2").Value
ThisFile = Range("B4").Value
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Macro Enabled Workbook" & "(*.xlsm), *xlsm", Title:=ThisFolder & ThisFile & ".xlsm", InitialFileName:="G:\New Manufacturing Engineering\Gear Shop\Spiral Bevel\Miscellaneous\Stock Removal Test File\" & ThisFolder & "\ " & ThisFile & ".xlsm")
With ActiveWorkbook
    On Error GoTo message
    .SaveAs varResult & ".xlsm", FileFormat:=52
    Exit Sub
message:
    MsgBox "There is an error"
End With
End Sub

我需要发生的是从原始文件夹中删除的原始文件已保存到

提前致谢