To copy the worksheet to a new workbook and rename it based on a specified cell value and save

[Kenor]

Hi All,

My previous post is about copying the worksheet and renaming it based on a specified cell value by using the click button.
But still in the same workbook.
See below the VBA code:-

Sub RectangleBeveled1_Click()
Dim ShtName As String

ShtName = Range("L1").Value & " " & Range("L2").Value & " " & Range("L5").Value
If ShtName = "" Then
MsgBox "no name entered"
Exit Sub
ElseIf Evaluate("isref('" & ShtName & "'!A1)") Then
MsgBox "Sheet name " & ShtName & " is already used"
Exit Sub
End If
ActiveSheet.Copy , Sheets(Sheets.Count)
ActiveSheet.Name = ShtName
End Sub


And then, I created another click button to clear the content on the existing worksheet.
I use the below VBA code:-

Sub RectangleBeveled2_Click()

Range("K1:M1").ClearContents
Range("B5:D5").ClearContents
Range("L5:M5").ClearContents
Range("B9:M16").ClearContents
Range("B20:M27").ClearContents

End Sub


So now, I need help to combine both VBA codes and make it copy the worksheet to a new workbook without opening it.

The purpose is to use the current worksheet only to enter daily data.
But can make one copy of the data to a new workbook every day with the press of a click button.

The image below is a list of daily data files in one folder.

 

[Kenor]

Anyone can help me?

 

[Kenor]

I tried the VBA code below but can only copy it in the same workbook as well.

There are some errors. I have no idea.



Sub Rectangle3_Click()

Dim path As String
path = "C:\Bent Hole Data\New Data\"

Dim ShtName As String

ShtName = Range("K1").Value & " " & Range("L5").Value
If ShtName = "" Then
MsgBox "no name entered"
Exit Sub
ElseIf Evaluate("isref('" & ShtName & "'!A1)") Then
MsgBox "Sheet name " & ShtName & " is already used"
Exit Sub
End If

Application.DisplayAlerts = False

ActiveSheet.Copy , Sheets(Sheets.Count)
ActiveSheet.Name = ShtName

With ActiveWorkbook
.SaveAs Filename:=path & ShtName, FileFormat:=51
.Close

End With

Application.DisplayAlerts = True

End Sub