Macro to save a copy of the worksheet as part of an existing script

[chrono2483]

Hello,

I've searched the forum for something similar to what I am looking to do. I have a tool, that runs a macro to clean up the data within. What I am looking to do is have it also save a copy of the end result as a unique name on the users desktop (or what ever specified location). Ideally, I would want the save name to be the name of the tool + the current date (or based on the date within a certain cell of the tool).

Is there a macro script available to accomplish this?

 

[Fishboy]

Hello,

I've searched the forum for something similar to what I am looking to do. I have a tool, that runs a macro to clean up the data within. What I am looking to do is have it also save a copy of the end result as a unique name on the users desktop (or what ever specified location). Ideally, I would want the save name to be the name of the tool + the current date (or based on the date within a certain cell of the tool).

Is there a macro script available to accomplish this?

Hi chrono2483,

Can you share with us the existing macro, and let us know the name of the tool and what cell you are looking at to get the date?

With these details we should be able to amend it to suit your needs.

 

[chrono2483]

Hi chrono2483,

Can you share with us the existing macro, and let us know the name of the tool and what cell you are looking at to get the date?

With these details we should be able to amend it to suit your needs.

Hi Fishboy,

The name of the tool is: 'Data Tracking Tool v.1', and the cell that has the date to be used is sheet "Report Dump", cell B2. Essentially, what i was hoping to do is have the user create a generic folder on their desktop, called "Data Tracking". And the macro would run as usual, but also save a copy of the results in this folder with the saved name: 'Data Tracking Tool v.1 + Date from cell B2'....with the date in B2 = dynamic date. Here is the existing macro:

Dim i As Long
Dim l As Long

' Prevents screen refreshing.
Application.ScreenUpdating = False

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Cells.Select
With Selection
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

ActiveWorkbook.Worksheets("Format sheet").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Format sheet").Sort.SortFields.Add Key:=Range( _
"E1:E5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Format sheet").Sort
.SetRange Range("B1:N1300")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Dim LastRow As Long, myCell As Range, myRange As Range
Dim myCell1 As Range

LastRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row 'find last row
Set myCell1 = Range("E" & LastRow)
Cells.Find(What:="Date", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Set myCell = ActiveCell

Set myRange = Range(myCell, myCell1) 'select from last row to current row selected
myRange.EntireRow.Delete Shift:=xlUp 'delete

Sheets("Report Dump").Select
Columns("A:P").Select
Selection.ClearContents

Sheets("Format sheet").Select
Range("A1:P" & ActiveSheet.Cells.SpecialCells(xlLastCell).Row).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Report Dump").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select

Application.ScreenUpdating = True

End Sub


Thank you.