Copy sheet to new workbook with cell data as title

Question

I have used the below and want to modify it to not overwrite the file but create a new file how do I do that or can I modify the new file string to include a cell value in the file name + Daily Report cell value is = to yesterdays day and is formatted like 3-Mar-2022 so in the end I would want every new file to be yesterdays date + Daily Report

Option Explicit

Public Sub TestMe()

    Dim newWb As Workbook
    Dim newWbPath As String: newWbPath = ThisWorkbook.Path & "\Daily Report.xlsx"
    Set newWb = Workbooks.Add

    ThisWorkbook.Worksheets("Daily Reports").Cells.Copy
    newWb.Worksheets(1).Cells.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

    newWb.SaveAs newWbPath
    newWb.Close

End Sub

Answer 1

Export a Worksheet to a New Workbook

Copy Values Only

Sub ExportDailyReport()
    
    ' Source
    Const sName As String = "Daily Reports"
    ' Destination
    Const dName As String = "" ' if you don't want it to be e.g. 'Sheet1'
    ' I prefer " yyyymmdd hhmmss" (stays sorted in WinExp) and after the name.
    Const dDatePattern As String = "m-d-yyyy"
    Const dDateNameSeparator As String = " "
    Const dNameRight As String = "Daily Report.xlsx"
    ' Both
    Const DateCellAddress As String = "A1"
    
    ' Source
    
    Dim swb As Workbook: Set swb = ThisWorkbook
    Dim sws As Worksheet: Set sws = swb.Worksheets(sName)
    
    ' Reference the source range.
    Dim srg As Range: Set srg = sws.UsedRange
    
    ' Destination
    
    Application.ScreenUpdating = False
    
    Dim dwb As Workbook: Set dwb = Workbooks.Add(xlWBATWorksheet) ' single ws
    Dim dws As Worksheet: Set dws = dwb.Worksheets(1)
    If Len(dName) > 0 Then dws.Name = dName ' rename worksheet, or not
    
    ' Reference the destination range.
    Dim drg As Range: Set drg = dws.Range(srg.Cells(1).Address) _
        .Resize(srg.Rows.Count, srg.Columns.Count)
    
    ' Copy values by assignment (most efficient).
    drg.Value = srg.Value
    
    ' Build the destination file path.
    Dim dFilePath As String: dFilePath = swb.Path & "\" _
        & Format(dws.Range(DateCellAddress).Value, dDatePattern) _
        & dDateNameSeparator & dNameRight
    
    ' Save and close.
    Application.DisplayAlerts = False ' overwrite without confirmation
    dwb.SaveAs dFilePath
    Application.DisplayAlerts = True
    dwb.Close SaveChanges:=False
    
    ' Inform.
    Application.ScreenUpdating = True
    MsgBox "Daily report exported.", vbInformation

End Sub

Copy As-Is

Sub ExportDailyReportAsIs()
    
    ' Source
    Const sName As String = "Daily Reports"
    ' Destination
    Const dName As String = "" ' if you don't want it to be 'Daily Reports'
    ' I prefer " yyyymmdd hhmmss" (stays sorted in WinExp) and after the name.
    Const dDatePattern As String = "m-d-yyyy"
    Const dDateNameSeparator As String = " "
    Const dNameRight As String = "Daily Report.xlsx"
    ' Both
    Const DateCellAddress As String = "A1"
    
    ' Source
    
    Dim swb As Workbook: Set swb = ThisWorkbook
    Dim sws As Worksheet: Set sws = swb.Worksheets(sName)
    
    Application.ScreenUpdating = False
    
    ' Return the copy of the worksheet in a new workbook.
    sws.Copy
    
    ' Destination
    
    Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
    Dim dws As Worksheet: Set dws = dwb.Worksheets(1)
    If Len(dName) > 0 Then dws.Name = dName ' rename worksheet, or not
    ' To remove the formulas you can do:
    'dws.UsedRange.Value = dws.UsedRange.Value
    
    ' Build the destination file path.
    Dim dFilePath As String: dFilePath = swb.Path & "\" _
        & Format(dws.Range(DateCellAddress).Value, dDatePattern) _
        & dDateNameSeparator & dNameRight
    
    ' Save and close.
    Application.DisplayAlerts = False ' overwrite without confirmation
    dwb.SaveAs dFilePath
    Application.DisplayAlerts = True
    dwb.Close SaveChanges:=False
    
    ' Inform.
    Application.ScreenUpdating = True
    MsgBox "Daily report exported.", vbInformation

End Sub