save as desktop & save as macro free workbook

K

kelvin_9

Active Member
Joined
Mar 6, 2015
Messages
460
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

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
You must log in or register to reply here.

Similar threads

D
  • Solved
extract to another workbook and save using desktop path
2
Replies
12
Views
208
jolivanes
jolivanes
willow1985
  • Solved
VBA Run-time error 91 - Object variable or With block variable not set when trying to refresh data/Sleep
Replies
4
Views
398
willow1985
willow1985
A
  • Question Question
Need advise on code
2
Replies
11
Views
176
AlexanderBB
A
T
  • Solved
Left of character
Replies
8
Views
135
Peter_SSs
Peter_SSs
F
  • Solved
How to make loop stop when the cell is empty? (VBA)
Replies
3
Views
298
kvsrinivasamurthy
K

Forum statistics

Threads
1,224,748
Messages
6,180,721
Members
452,995
Latest member
isldboy

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