VBA Macro to copy only ACTIVE Sheet to new workbook as xslm and new location

[dinkss]

Hi there,

I have a macro like this which saves workbook to new location, and works fine. But I need to change this code to save only ACTIVE Sheet, not all of them. Basically I need macro to do 1 to 1 copy of active sheet in different location and will rename the file to original workbook name with date and time. Can anyone help me with this?

Sub SAVE_TO_ARCHIVE()
' Saves active file to current plus backup location, appends system date and time in front of file name in backup locations.

Dim datim As String
datim = Format(CStr(Now), "yyyy_mm_dd_hh_mm_ss_")

ActiveWorkbook.SaveCopyAs "E:\****pack\KAROL_KITPACK_DOWNTIME_TEMP\ARCHIVE\" & datim & ActiveWorkbook.Name
ActiveWorkbook.Save

MsgBox "You can find archived files in E:\****pack\KAROL_KITPACK_DOWNTIME_TEMP\ARCHIVE\ " & FolderName
Application.ScreenUpdating = True
End Sub

 

[HaHoBe]

Hi dinkss,

modules to be placed in ThisWorkbook:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
BBK_AUTO_STOP
End Sub

Private Sub Workbook_Open()
BBK_AUTO_SAVE
End Sub

In a standard module:

Public NextTime As Date
Sub BBK_AUTO_SAVE()

NextTime = Now + TimeValue("01:00:00")
Application.OnTime NextTime, "BBK_AUTO_SAVE"

ActiveWorkbook.Save

End Sub

Sub BBK_AUTO_STOP()

Application.OnTime NextTime, "BBK_AUTO_SAVE", , False

End Sub

Ciao,
Holger

 

[dinkss]

Hi dinkss,

modules to be placed in ThisWorkbook:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
BBK_AUTO_STOP
End Sub

Private Sub Workbook_Open()
BBK_AUTO_SAVE
End Sub

In a standard module:

Public NextTime As Date
Sub BBK_AUTO_SAVE()

NextTime = Now + TimeValue("01:00:00")
Application.OnTime NextTime, "BBK_AUTO_SAVE"

ActiveWorkbook.Save

End Sub

Sub BBK_AUTO_STOP()

Application.OnTime NextTime, "BBK_AUTO_SAVE", , False

End Sub

Ciao,
Holger

Cheers, good man,

I will try this

 

[dinkss]

Cheers, good man,

I will try this

I just tried your vba code and I'm getting this error, see screenshots. Any help my friend?

 

[HaHoBe]

Hi dinkss,

I can reprdice the error when I stop the timer manually and then try to close the workbook.

PLease try changing the code in the standard module to

Public NextTime As Date
Public blnTimerOn As Boolean

Sub BBK_AUTO_SAVE()
blnTimerOn = True

NextTime = Now + TimeValue("01:00:00")
Application.OnTime NextTime, "BBK_AUTO_SAVE"

ActiveWorkbook.Save

End Sub

Sub BBK_AUTO_STOP()
If blnTimerOn Then
  Application.OnTime NextTime, "BBK_AUTO_SAVE", , False
End If
End Sub

Ciao,
Holger

 

[dinkss]

Hi dinkss,

I can reprdice the error when I stop the timer manually and then try to close the workbook.

PLease try changing the code in the standard module to

Public NextTime As Date
Public blnTimerOn As Boolean

Sub BBK_AUTO_SAVE()
blnTimerOn = True

NextTime = Now + TimeValue("01:00:00")
Application.OnTime NextTime, "BBK_AUTO_SAVE"

ActiveWorkbook.Save

End Sub

Sub BBK_AUTO_STOP()
If blnTimerOn Then
  Application.OnTime NextTime, "BBK_AUTO_SAVE", , False
End If
End Sub

Ciao,
Holger

I will try again and let you know. Thank you!

 

[dinkss]

Hi dinkiss,

where does foldername in your macro get it`s value?

Code for the ActiveSsheet may look like this

Sub SAVE_ACTIOVESHEET_TO_ARCHIVE()
' Saves active sheet to current plus backup location, appends system date and time in front of file name in backup locations.
'https://www.mrexcel.com/board/threads/vba-macro-to-copy-only-active-sheet-to-new-workbook-as-xslm-and-new-location.1171883/

Dim datim As String
Dim strWbName As String

Const cstrPATH As String = "E:\****pack\KAROL_KITPACK_DOWNTIME_TEMP\ARCHIVE\"
datim = Format(Now, "yyyy_mm_dd_hh_mm_ss_")
strWbName = ActiveWorkbook.Name

ActiveSheet.Copy
ActiveWorkbook.SaveAs cstrPATH & datim & strWbName, FileFormat:=51
ActiveWorkbook.Close False

MsgBox "You can find archived worksheet in " & cstrPATH & datim & strWbName
'Application.ScreenUpdating = True
End Sub

Ciao,
Holger

HI Buddy,

I have used your macro fine, it does the job, but now I'm havening problem opening exported sheet as this macro doesn't save modules - macros included in my original workbook. Can this be changed to include macro in exported sheet?

Please help me again buddy.

Thanks

 

[HaHoBe]

Hi dinkss,

any code behind the sheet will be exported, other codes like ThisWorkbook, UserForm and modules won´t . You could opt for saving the whole workbook and deleting the sheets unwanted (using Application.DisplayAlerts = False at the beginning and ~ = True at the end in order to avaoid notifications from the application about deleting sheets) or copy over all necessary code (the setting for Trust.. in the Trust center must be on). I´d have a go with the first option.

Ciao,
Holger