Auto Saving File to Folder with Current Date

Hi,

I have learnt how to auto create a folder named with the current date. Now, I would like my macro to save it to the folder i have just created, that is numbered with current date. Can anyone let me know how this can be achieved ? Thank you.

Regards,
Jeffrey

Hello Jeffery,

It is hard to answer an incomplete question. Please proof read your posts before posting them. You need to include what type of file you want to save to this new folder e.g. xls, csv, txt, etc. This impacts what code will be used to save the file.

Sincerely,
Leith Ross

Hi,

Thanks. I would like to save my file as a .csv and here is my code for the macro. Do i need to alter my date format so it reads the yymmdd, in that way, the macro which is to be written will choose the highest value or is there any other way ? thanks

Sub test()
    Dim myDir  As String
    Dim fn     As String
    Dim ws As Worksheet
    Dim LastR  As Long
    Dim rng    As Range
    Dim ct As Integer
    Dim At As Integer
    Dim sFolder As String

    
    

    ct = 0
    
    

    myDir = "C:\Documents and Settings\Jeffrey\My Documents\Ebay CSV Download\Temp Batch 1"    '<- change to actual folder path
    fn = Dir(myDir & "\*.csv")
    Do While fn <> ""
    
       ct = 1 + ct

        With Workbooks.Open(myDir & "\" & fn)
            LastR = ThisWorkbook.Sheets(1).UsedRange.SpecialCells(11).Row + 1
            
            For Each ws In .Sheets
                
                If ct < 2 Then
            
                    'For Each ws In .Sheets
            
            
                    With ws.UsedRange
                    .Resize(.Rows.count - 3).Copy
                    End With
            
                    ThisWorkbook.Sheets(1).Range("a" & LastR).PasteSpecial
            
                Else
            
            
                       
        
            
            
                    'For Each ws In .Sheets
                      Set rng = ws.UsedRange
                    rng.Offset(2, 0).Resize(rng.Rows.count - 4, _
                                          rng.Columns.count).Copy ThisWorkbook.Sheets(1).Cells(LastR, 1)
            
            
        End If
            
            
            Next
            Application.CutCopyMode = False
            .Close False
        End With
        fn = Dir()
    Loop
    Application.DisplayAlerts = False
    
    
sFolder = CStr(Format(Date, "ddmmyy"))
MkDir "C:\Documents and Settings\Jeffrey\My Documents\Download\Mail Merge Ready Files" & sFolder
    
    
    ' ChDir "C:\My Documents\" & sFolder

   ' ChDir "C:\AfterMerged"

    ' ThisWorkbook.SaveAs Format(Date, "yy-mm-dd") & ".csv", xlCSV
    ' Application.DisplayAlerts = True
    
    ct = 0

End Sub