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
CodePudding user response:
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