Excel Forum

Code: Select all

Sub Save_As()
'
' SaveAs Macro
'

'

'MSG BOX

Dim x As Integer
x = MsgBox("???????? Save As (??????) ??????? ?????????????????????", vbOKCancel, "Contact Rate")
If x = vbOK Then
' SaveAs Macro

ActiveSheet.Unprotect
ChDir "D:\"
ActiveWorkbook.SaveAs Filename:= _
"D:\HELP" & Format(Now(), "DD-MM-YYYY.xlsx" & ""), FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Rows("4:40").Select
Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("D3").Select
Rows("1:1").EntireRow.AutoFit
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveWorkbook.Save

MsgBox ("COMPLETED>>>Save As Drive D:")

'MSG BOX
Else
Sheets("FORMAT EXCEL V.11").Select

End If
End Sub

Code: Select all

ActiveWorkbook.SaveAs Filename:= _
    "D:\HELP\" & Format(Now(), "DD-MM-YYYY"), FileFormat:= _
    xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

Code: Select all

Sub Save_As_NEW()
'
' SaveAs Macro
'

'

    'MSG BOX

    Dim x As Integer
    x = MsgBox("???????? Save As (??????) ??????? ?????????????????????", vbOKCancel, "Contact Rate")
    If x = vbOK Then
  ' SaveAs Macro
    
    ActiveSheet.Unprotect
    ActiveWorkbook.Date1904 = True
    Rows("4:39").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ChDir "D:\"
    ActiveWorkbook.SaveAs Filename:= _
        "D:\" & ActiveSheet.Range("A4").Value & ".xlsx", FileFormat:= _
        xlOpenXMLStrictWorkbook, CreateBackup:=False
    
    
    
    Range("D3").Select
    Rows("1:1").EntireRow.AutoFit
    Rows("1:3").Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    
    ActiveWorkbook.Save
    
    MsgBox ("COMPLETED>>>Save at Drive D:")
    
    
    ActiveWorkbook.Close
    
    
    'MSG BOX
    Else
         Sheets("FORMAT EXCEL V.11").Select
         
    End If
End Sub