save a file depending on the date value on cell

[mark692]

hello guys is i need a code that will safe a workbook on different location and will set the file name depending on the value on the cell, the format of the cell is in date, thanks

 

[Kamolga]

Sub saveas()
Dim wName As String
[COLOR=#008000]'Name of the workbook : replace A1 by the date Cell and format as wished. If today's date, the file here would be named 14.12.2018[/COLOR]
wName = Format(Range("[COLOR=#ff0000]A1[/COLOR]").Value, "[COLOR=#ff0000]dd.mm.yyyy[/COLOR]")
Dim wPath
[COLOR=#008000]'Define the folder[/COLOR]
wPath = "C:\[COLOR=#ff0000]8[/COLOR]\"
ThisWorkbook.saveas Filename:=wPath & wName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

 

[mark692]

Sub saveas()
Dim wName As String
[COLOR=#008000]'Name of the workbook : replace A1 by the date Cell and format as wished. If today's date, the file here would be named 14.12.2018[/COLOR]
wName = Format(Range("[COLOR=#ff0000]A1[/COLOR]").Value, "[COLOR=#ff0000]dd.mm.yyyy[/COLOR]")
Dim wPath
[COLOR=#008000]'Define the folder[/COLOR]
wPath = "C:\[COLOR=#ff0000]8[/COLOR]\"
ThisWorkbook.saveas Filename:=wPath & wName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

this works thank you so much but i changed the format "dd.mm.yyyy" to "dd-mm-yyyy" i think dd.mm.yyyy gives different file, thanks anyway!

 

[mark692]

hello sir i have another question, i want to add on the code that will not notify me if there is the same filename on the location instead it will just automatically save and just add (1)

sample:

1-25-18
1-25-18(1)
1-25-18(2)

like that sir

 

[mark692]

Up

 

[mrshl9898]

How's this?

Sub Test_File_Exist_With_Dir()

Dim wName As String
Dim FilePath As String
Dim counter As Long
Dim counter2 As Long
Dim success As Long


counter = 1
counter2 = 1
success = 0
wName = Format(Range("A1").Value, "dd-mm-yyyy")
wPath = [COLOR=#333333]"C:\[/COLOR][COLOR=#ff0000]8[/COLOR][COLOR=#333333]\"[/COLOR]


Do Until success = 1
    Application.ScreenUpdating = False


    FilePath = ""
    On Error Resume Next
    FilePath = Dir(wPath & wName & ".xlsm")
    On Error GoTo 0
    If FilePath = "" Then
        ThisWorkbook.saveas Filename:=wPath & wName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        success = 1
    Else
        wName = Format(Range("A1").Value, "dd-mm-yyyy") & "(" & counter & ")"
        If counter2 <> 1 Then
        counter = counter + 1
        End If
        counter2 = counter2 + 1
    End If
Loop
    Application.ScreenUpdating = False
End Sub

 

[mark692]

this works thanks sir mrshl9898 !!