How to take backup of current sheet or workbook - excel

Question

Hy, I have an excel workbook which consists of six worksheets. Everything is working fine in the workbook. I have written a macro which helps me to take the backup of current workbook instead of the current worksheet. The code is as under.
Sub FileSaveAs()
Dim strFolder As String
Dim i As Long
'Find the position of the period in the file name
i = InStr(ActiveWorkbook.Name, ".")
'Create a default file name by concatenating the file name without the extention _
plus the current date and time, and plus the xlsm extention
Filename = Left(ActiveWorkbook.Name, i - 1) & "_" & Format(Now, "yyyy-mm-dd_hh mm") & ".xlsm"
'Open Save As dialog to a default folder with default file name
With Application.FileDialog(msoFileDialogSaveAs)
.AllowMultiSelect = False
.FilterIndex = 2 '2 = xlsm
.InitialFileName = "Report" & Filename
.InitialView = msoFileDialogViewDetails
If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
.Execute
End With
End Sub
It is working fine for taking backup of workbook instead of the current working sheet without losing any data or formate or setting in the worksheet.
I have two problems.
1- When I click on the backup button, the active workbook is closed and backup workbook is opened.
2- I tried my best to take the backup of the current working sheet without losing any data or formating but I cloud not do so because everything when I click on the backup button for the current worksheet (I have written another macro to take backup for current worksheet but it is not working so I did not write it here) is lost.
What I want to do. I want to do two things.
1- When I click the backup button, the original worksheet remain open while the backup worksheet should remain close, so that I can take different name backups from same master worksheet.
2- If possible, I want a macro which helps me to take the backup of the active sheet without losing any data or information on the sheet.
Please guide where i am doing wrong. Thanks for every member.

Answer 1

Try,
Sub FileSaveAs()
Dim strFolder As String
Dim i As Long
Dim Fn As String
Dim Wb As Workbook
Set Wb = ThisWorkbook
Fn = Wb.FullName
Wb.Save
'Find the position of the period in the file name
i = InStr(ActiveWorkbook.Name, ".")
'Create a default file name by concatenating the file name without the extention _
plus the current date and time, and plus the xlsm extention
Filename = Left(ActiveWorkbook.Name, i - 1) & "_" & Format(Now, "yyyy-mm-dd_hh mm") & ".xlsm"
'Open Save As dialog to a default folder with default file name
With Application.FileDialog(msoFileDialogSaveAs)
.AllowMultiSelect = False
.FilterIndex = 2 '2 = xlsm
.InitialFileName = "Report" & Filename
.InitialView = msoFileDialogViewDetails
If .Show = -1 Then strFolder = .SelectedItems(1) Else Exit Sub
.Execute
End With
Set Wb = ActiveWorkbook
Workbooks.Open (Fn)
Wb.Close (0)
End Sub