Create a Hardcoded Workbook Copy

Hi

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

Thanks in advance

Attachment 27507

Code:

---

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

---

I'd suggest to follow a course in VBA basics first before continuing this path.

Thanks for your advice VBAX Guru. I'm in the middle of a VBA course

.
Try this :

Code:

---

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.

@ Logit
Thanks for your response. But I need to create a copy of the workbook without any formulas

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

.

See if you can start with this ...

Code:

---

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

---

Thanks Logit

.
You are welcome. Let us know if you need more help.

Code:

---

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

---

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

Code:

---

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

---

.
:thumb