PDA

View Full Version : [SOLVED:] Create a Hardcoded Workbook Copy



anish.ms
11-27-2020, 11:30 AM
Hi

I' getting the following error while running the trailing code. Could somebody please help me to correct the codes?

Thanks in advance

27507


Sub Hardcoded_Workbook_Copy()

Dim FilePath As String
Dim HCName As String

FilePath = ActiveWorkbook.Path & "\"
HCName = "HC_" & VBA.Format(Date, "ddmmyy") & "_" & ActiveWorkbook.Name
ActiveWorkbook.Save
Sheets.Select
Cells.Copy
Cells.PasteSpecial xlPasteValues
Range("A1").Select
Sheets(1).Select
ActiveWorkbook.SaveAs Filename:=FilePath & HCName

End Sub

snb
11-28-2020, 09:01 AM
I'd suggest to follow a course in VBA basics first before continuing this path.

anish.ms
11-28-2020, 10:33 AM
Thanks for your advice VBAX Guru. I'm in the middle of a VBA course

Logit
11-29-2020, 10:20 AM
.
Try this :



Option Explicit


Sub Hardcoded_Workbook_Copy()


Dim FilePath As String
Dim HCName As String

FilePath = ActiveWorkbook.Path & "\"
HCName = "HC_" & VBA.Format(Date, "ddmmyy") & "_" & ActiveWorkbook.Name
'ActiveWorkbook.Save
'Sheets.Select
'Cells.Copy
'Cells.PasteSpecial xlPasteValues

ActiveWorkbook.SaveAs Filename:=FilePath & HCName
Sheets(1).Select
Range("A1").Select
End Sub


You are going through a number of steps in your original macro which results in a backup of your workbook. Rather than copy / paste all the sheets
... just copy the entire workbook and re-create it as a backup.

Your path will force VBA to create a COPY. If you don't want the term COPY at the end of the file name ... code a different folder for the backup to
be saved in.

anish.ms
11-29-2020, 11:51 AM
@ Logit (http://www.vbaexpress.com/forum/member.php?61536-Logit)
Thanks for your response. But I need to create a copy of the workbook without any formulas

Paul_Hossler
11-29-2020, 12:08 PM
It'd be helpful if your sample had data, formulas, multiple sheets, and links that worked

If you provided an updated one, it's be easier to see

Logit
11-29-2020, 12:20 PM
.

See if you can start with this ...



Option Explicit


Sub abcd()
Dim myWB As Workbook, WB As Workbook
Dim myName
Dim ws As Worksheet


Set myWB = ThisWorkbook
myName = ThisWorkbook.Name


Dim r As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False


For Each ws In Sheets
For Each r In ws.UsedRange
If Not IsEmpty(r) Then r.Value = r.Value
Next
Next


ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\FILE XLSX.xlsm")
Set WB = ActiveWorkbook


Application.DisplayAlerts = True


Workbooks.Open (ThisWorkbook.Path & "\" & myName)
WB.Close


Application.ScreenUpdating = True
End Sub

anish.ms
11-29-2020, 12:46 PM
Thanks Logit (http://www.vbaexpress.com/forum/member.php?61536-Logit)

Logit
11-29-2020, 05:32 PM
.
You are welcome. Let us know if you need more help.

snb
11-30-2020, 01:32 AM
Sub M_snb()
For Each it In Sheets
it.UsedRange.Value = it.UsedRange.Value
Next

ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & Replace(ActiveWorkbook.Name, ".", "_backup.")
End Sub

anish.ms
11-30-2020, 03:13 AM
Thanks for all your support.
I have replaced 'Thisworkbook' to 'Activeworkbook to have this code in my personal.xlsb to use as and when required



Option Explicit


Sub Hardcoded_Workbook_Copy()


Dim Original_WB As Workbook
Dim MyName As String, HCName As String
Dim WS As Worksheet




Set Original_WB = ActiveWorkbook
MyName = Original_WB.Name
HCName = "HC_" & VBA.Format(Date, "ddmmyyyy") & "_" & Original_WB.Name


Dim r As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False


Original_WB.Save


For Each WS In Sheets
For Each r In WS.UsedRange
If Not IsEmpty(r) Then r.Value = r.Value
Next
Next




Original_WB.SaveAs (Original_WB.Path & "\" & HCName)


Application.DisplayAlerts = True


Workbooks.Open (Original_WB.Path & "\" & MyName)
Workbooks(HCName).Close


Application.ScreenUpdating = True


End Sub

Logit
11-30-2020, 08:24 AM
.
:thumb