0

i have created a macro to save a sheet to a specific location (see below): 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

This sheet needs to be reviewed and then saved to a different location using this macro:

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

What i need to happen is the original file is deleted from the original folder is was saved to

Thanks in advance

Maxe1984
  • 37
  • 6

0 Answers0