save as desktop & save as macro free workbook

K

kelvin_9

Active Member
Joined
Mar 6, 2015
Messages
444
Office Version
  1. 2019
Hello All,

i was thinking how can i save my workbook as macro-free workbook at desktop with the file name along today's date and date format likely MM-DD-YYYY (one is 04-12-2022 home delivery and the other one is 04-12-2022 limited delivery)
ps1. i save the workbook once a day, so the name for next day need to be 04-13-2022 home delivery and 04-13-2022 limited delivery
ps2. i guess the code need to be added under "delete object and move" and above "clear data in sheet3 if any"

thank you very much

my code here

VBA Code: 
Option Explicit
Sub Macro1()
'
'
'

'

'NORMAL HOME

Dim WS_1 As Worksheet
    Set WS_1 = Sheets("Sheet1")
Dim WS_2 As Worksheet
    Set WS_2 = Sheets("Sheet2")
Dim WS_3 As Worksheet
    Set WS_3 = Sheets("Sheet3")
Dim Lr As Long

    'filter store and location
    WS_1.Activate
    WS_1.Rows("1:1").AutoFilter
    WS_1.Range("$A$1:$V$1").AutoFilter Field:=2, Criteria1:="NORMAL"
    WS_1.Range("$A$1:$V$1").AutoFilter Field:=10, Criteria1:="="
    Cells.Copy
    WS_2.Activate
    WS_2.Paste

    'back to worksheet 1
    WS_1.Activate
    WS_1.Range("A1").AutoFilter

    'copy order id
    WS_2.Activate
    WS_2.Range("A2", Range("A2").End(xlDown)).Copy
    WS_3.Activate
    WS_3.Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

   'Find last row in column F with data
    Lr = Cells(Rows.Count, "F").End(xlUp).Row
    WS_3.Range("B2:B" & Lr).FormulaR1C1 = "=RC[-1]+2"
    WS_3.Range("D2:D" & Lr).Value = "123456"
    WS_3.Range("E2:E" & Lr).Value = "ABC"
    WS_3.Range("G2:G" & Lr).FormulaR1C1 = "=CONCATENATE(Sheet2!RC[13],"" "",Sheet2!RC[12])"

    'fill address
    WS_2.Activate
    WS_2.Range("V2:W1000").Copy
    WS_3.Activate
    WS_3.Range("H2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    WS_2.Activate
    WS_2.Range("Y2:Y1000").Copy
    WS_3.Activate
    WS_3.Range("K2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'fill phone
    WS_2.Activate
    WS_2.Range("U2:U1000").Copy
    WS_3.Activate
    WS_3.Range("L2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    WS_2.Activate
    WS_2.Range("I2:I1000").Copy
    WS_3.Activate
    WS_3.Range("M2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    WS_3.Range("N2:N" & Lr).FormulaR1C1 = "=CONCATENATE(""ORDER ID #"","""",RC[-8])"
    WS_3.Range("Q2:Q" & Lr).Value = "box"
    WS_3.Range("R2:R" & Lr).Value = "1"
    WS_3.Range("S2:S" & Lr).Value = "3"

    'fill date
    If Lr > 2 Then
    WS_3.Range("A3:A" & Lr).Value = WS_3.Range("A2").Value
    End If

    'value
    WS_3.Cells.Copy
    WS_3.Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'clear data in sheet2 if any
    WS_2.Activate
    WS_2.Cells.Delete Shift:=xlUp
    WS_2.Range("A1").Select
    WS_1.Activate
    WS_1.Cells.Select
    WS_1.Cells.EntireColumn.AutoFit
    WS_1.Range("A1").Select

    'delete object and move
    WS_3.Activate
    WS_3.Copy
    Sheets("Sheet3").Name = "normal home"
    ActiveSheet.DrawingObjects.Select
    Selection.Delete

    'clear data in sheet3 if any
    WS_3.Rows("2:1000").Delete
    With WS_3.Range("A2").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0
    End With

End Sub
Sub Macro2()
'
'
'

'

'LIMITED HOME

Dim WS_1 As Worksheet
    Set WS_1 = Sheets("Sheet1")
Dim WS_2 As Worksheet
    Set WS_2 = Sheets("Sheet2")
Dim WS_3 As Worksheet
    Set WS_3 = Sheets("Sheet3")
Dim Lr As Long

    'filter store and location
    WS_1.Activate
    WS_1.Rows("1:1").AutoFilter
    WS_1.Range("$A$1:$V$1").AutoFilter Field:=2, Criteria1:="limited"
    WS_1.Range("$A$1:$V$1").AutoFilter Field:=10, Criteria1:="="
    Cells.Copy
    WS_2.Activate
    WS_2.Paste

    'back to worksheet 1
    WS_1.Activate
    WS_1.Range("A1").AutoFilter
    'copy order id
    WS_2.Activate
    WS_2.Range("A2", Range("A2").End(xlDown)).Copy
    WS_3.Activate
    WS_3.Range("F2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

   'Find last row in column F with data
    Lr = Cells(Rows.Count, "F").End(xlUp).Row
    WS_3.Range("B2:B" & Lr).FormulaR1C1 = "=RC[-1]+2"
    WS_3.Range("D2:D" & Lr).Value = "123456"
    WS_3.Range("E2:E" & Lr).Value = "ABC"
    WS_3.Range("G2:G" & Lr).FormulaR1C1 = "=CONCATENATE(Sheet2!RC[13],"" "",Sheet2!RC[12])"
    
    'fill address
    WS_2.Activate
    WS_2.Range("V2:W1000").Copy
    WS_3.Activate
    WS_3.Range("H2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    WS_2.Activate
    WS_2.Range("Y2:Y1000").Copy
    WS_3.Activate
    WS_3.Range("K2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'fill phone
    WS_2.Activate
    WS_2.Range("U2:U1000").Copy
    WS_3.Activate
    WS_3.Range("L2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    WS_2.Activate
    WS_2.Range("I2:I1000").Copy
    WS_3.Activate
    WS_3.Range("M2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    WS_3.Range("N2:N" & Lr).FormulaR1C1 = "=CONCATENATE(""ORDER ID #"","""",RC[-8])"
    WS_3.Range("Q2:Q" & Lr).Value = "box"
    WS_3.Range("R2:R" & Lr).Value = "1"
    WS_3.Range("S2:S" & Lr).Value = "3"

    'fill date
    If Lr > 2 Then
    WS_3.Range("A3:A" & Lr).Value = WS_3.Range("A2").Value
    End If

    'value
    WS_3.Cells.Copy
    WS_3.Cells.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    'clear data in sheet2 if any
    WS_2.Activate
    WS_2.Cells.Delete Shift:=xlUp
    WS_2.Range("A1").Select
    WS_1.Activate
    WS_1.Cells.Select
    WS_1.Cells.EntireColumn.AutoFit
    WS_1.Range("A1").Select

    'delete object and move
    WS_3.Activate
    WS_3.Copy
    Sheets("Sheet3").Name = "limited home"
    ActiveSheet.DrawingObjects.Select
    Selection.Delete

    'clear data in sheet3 if any
    WS_3.Rows("2:1000").Delete
    With WS_3.Range("A2").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.499984740745262
        .PatternTintAndShade = 0
    End With

End Sub
 
Sort by date Sort by votes
John_w said:
I really can't help further without your workbook, however it requires a password to open it.
Click to expand...
Hi John_w
thank you very much for your reply

i did it finally,
save the worksheet in a new workbook, with no object, with specific name, date, and remain the object in the original workbook
i'm sorry for being messed since first post

thank you very much for your kindness and helpful
 
Upvote 0

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
You must log in or register to reply here.

Similar threads

H
  • Question
VBA Speed up Copy and paste
Replies
3
Views
371
skillilea
S
J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
168
shknbk2
S
P
  • Solved
Counter in For Each loop
Replies
2
Views
198
Possum17
P
S
  • Solved
VBA does not continue to copy after blank cell
Replies
8
Views
526
jolivanes
jolivanes
P
  • Question
Help with Vba Code
Replies
3
Views
162
Coyotex3
C

Forum statistics

Threads
1,215,059
Messages
6,122,918
Members
449,093
Latest member
dbomb1414

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top