create a folder and copy the documents that are in a folder - VBA

jevi

Active Member
Joined
Apr 13, 2010
Messages
339
Office Version
  1. 2016
Platform
  1. Windows
Hi All,

I have a Report Folder and inside it are some files that I use for everyday reporting and then the folders with the date Today ()-1. I would like a macro then can create the folder with the date Today()-1 from Tuesday to Friday and then on Monday Today ()-3 and copy the files are in the folder Report.

It would be fantastic if all the files that are copied in the new folder for example of today the folder I created is 26.05.2022 have the date at the end of the name of the files...for example if a report is named: Cash when is it copied to the folder of 26.05.2022, to be Cash 26.05.2022

Thank you,
 

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).
Try this macro, changing the reportFolder string.
VBA Code:
Public Sub Copy_Report_Files_To_Dated_Subfolder()

    Dim reportFolder As String, destFolder As String
    Dim destFolderDate As Date
    Dim file As String
    Dim p As Long
    
    reportFolder = "C:\path\to\Report Folder\"
    
    If Right(reportFolder, 1) <> "\" Then reportFolder = reportFolder & "\"
    
    If Weekday(Date) = vbMonday Then
        destFolderDate = Date - 3
    Else
        destFolderDate = Date - 1
    End If
    
    destFolder = reportFolder & Format(destFolderDate, "dd.mm.yyyy") & "\"
    If Dir(destFolder, vbDirectory) = vbNullString Then MkDir destFolder
    
    file = Dir(reportFolder & "*.*")
    While file <> vbNullString
        p = InStrRev(file, ".")
        FileCopy reportFolder & file, destFolder & Left(file, p - 1) & Format(destFolderDate, " dd.mm.yyyy") & Mid(file, p)
        file = Dir
    Wend
    
End Sub
 
Upvote 0
Solution
Hi John,
It worked super super...so thank you so much:).
Another question if you don't mind as I have another report that I need to do a copy of "Report" and rename the sheet with the date with the same logic if Monday -3, and if other days -1. I try to copy your code and put it like that but is not working.

at the beggining of the registered code I did put this
VBA Code:
Dim SheetsName As Date

and then when it is the part to rename it I did put this.
VBA Code:
If Weekday(Date) = vbMonday Then
    Sheets("Report (2)").Name = Date - 3
    Else
    Sheets("Report ICR (2)").Name = Date - 1
    End If

thank you so much,
 
Upvote 0
Please start a new thread because your new question is not related to copying files.
 
Upvote 0
Hi John,
I did but they told me that it is a duplicate and I can't..but I thought was another issue as it was to rename a sheet even the logic was -3 if Monday and -1 if else.

 
Upvote 0
Hi John,
It worked super super...so thank you so much:).
Another question if you don't mind as I have another report that I need to do a copy of "Report" and rename the sheet with the date with the same logic if Monday -3, and if other days -1. I try to copy your code and put it like that but is not working.

at the beggining of the registered code I did put this
VBA Code:
Dim SheetsName As Date

and then when it is the part to rename it I did put this.
VBA Code:
If Weekday(Date) = vbMonday Then
    Sheets("Report (2)").Name = Date - 3
    Else
    Sheets("Report ICR (2)").Name = Date - 1
    End If

thank you so much,
Hi John,
It worked super super...so thank you so much:).
Another question if you don't mind as I have another report that I need to do a copy of "Report" and rename the sheet with the date with the same logic if Monday -3, and if other days -1. I try to copy your code and put it like that but is not working.

at the beggining of the registered code I did put this
VBA Code:
Dim SheetsName As Date

and then when it is the part to rename it I did put this.
VBA Code:
If Weekday(Date) = vbMonday Then
    Sheets("Report (2)").Name = Date - 3
    Else
    Sheets("Report ICR (2)").Name = Date - 1
    End If

thank you so much,
I'm not sure where you have put this but what happened, if anything, when you run it?

Did you get an error message and on which line?
 
Upvote 0
Hi HighandWilder,

I did put the code in this macro that I registered. it gives a yellow line at the Sheets("Report I (2)").Name = Date - 3
I did put the code in red that one that I added.

Thank you,

VBA Code:
Sub Macro2()
'
' Macro2 Macro
'

'
    [COLOR=rgb(184, 49, 47)][B]Dim SheetsName As Date[/B][/COLOR]
    Sheets("Report I").Select
    Sheets("Pivot").Visible = True
    Sheets("Database").Visible = True
    Sheets("Pivot Precedente").Visible = True
    Sheets("Precedente").Visible = True
    Sheets("Database").Select
    Columns("A:F").Select
    Selection.Copy
    Sheets("Precedente").Select
    Columns("A:F").Select
    ActiveSheet.Paste
    Windows("Report I Database.xlsx").Activate
    Columns("A:F").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("IREPORT.xlsm").Activate
    Sheets("Database").Select
    ActiveSheet.Paste
    Sheets("Pivot").Select
    Application.CutCopyMode = False
    ActiveWorkbook.RefreshAll
    Sheets("Report I").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("E13").Select
    Sheets("Report I").Copy Before:=Sheets(6)
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(Array("Pivot", "Database", "Pivot Precedente", "Precedente")).Select
    Sheets("Precedente").Activate
    ActiveWindow.SelectedSheets.Visible = False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=+TODAY()-1"
    Range("F13").Select
    ActiveCell.FormulaR1C1 = "=+RC[-1]-3"
    Range("E13").Select
    Selection.Copy
    Sheets("Report I (2)").Select
    [COLOR=rgb(184, 49, 47)][B]If Weekday(Date) = vbMonday Then
    Sheets("Report I (2)").Name = Date - 3
    Else
    Sheets("Report I (2)").Name = Date - 1
    End If[/B][/COLOR]
    Sheets("Report I").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    Windows("Report I Database.xlsx").Activate
    ActiveWindow.Close
End If
End Sub
 
Upvote 0
Hi HighandWilder,

I did put the code in this macro that I registered. it gives a yellow line at the Sheets("Report I (2)").Name = Date - 3
I did put the code in red that one that I added.

Thank you,

VBA Code:
Sub Macro2()
'
' Macro2 Macro
'

'
    [COLOR=rgb(184, 49, 47)][B]Dim SheetsName As Date[/B][/COLOR]
    Sheets("Report I").Select
    Sheets("Pivot").Visible = True
    Sheets("Database").Visible = True
    Sheets("Pivot Precedente").Visible = True
    Sheets("Precedente").Visible = True
    Sheets("Database").Select
    Columns("A:F").Select
    Selection.Copy
    Sheets("Precedente").Select
    Columns("A:F").Select
    ActiveSheet.Paste
    Windows("Report I Database.xlsx").Activate
    Columns("A:F").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("IREPORT.xlsm").Activate
    Sheets("Database").Select
    ActiveSheet.Paste
    Sheets("Pivot").Select
    Application.CutCopyMode = False
    ActiveWorkbook.RefreshAll
    Sheets("Report I").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("E13").Select
    Sheets("Report I").Copy Before:=Sheets(6)
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(Array("Pivot", "Database", "Pivot Precedente", "Precedente")).Select
    Sheets("Precedente").Activate
    ActiveWindow.SelectedSheets.Visible = False
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=+TODAY()-1"
    Range("F13").Select
    ActiveCell.FormulaR1C1 = "=+RC[-1]-3"
    Range("E13").Select
    Selection.Copy
    Sheets("Report I (2)").Select
    [COLOR=rgb(184, 49, 47)][B]If Weekday(Date) = vbMonday Then
    Sheets("Report I (2)").Name = Date - 3
    Else
    Sheets("Report I (2)").Name = Date - 1
    End If[/B][/COLOR]
    Sheets("Report I").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    Windows("Report I Database.xlsx").Activate
    ActiveWindow.Close
End If
End Sub
Check the worksheet names and that they actually exist. What error message did you get?
 
Upvote 0
Check the worksheet names and that they actually exist. What error message did you get?


the error is: Sheets("Report ICR(2)").Name = Date - 1
Index non included in the range is says.
1654001617434.png
 
Upvote 0
I did but they told me that it is a duplicate and I can't..but I thought was another issue as it was to rename a sheet even the logic was -3 if Monday and -1 if else.
A duplicate is the same question asked in different threads, so I don't see how it is a duplicate because your new question is about renaming sheets.

Note that the backslash "/" is an invalid character in sheet names, so if you want the sheet name to relate to the date then try:
VBA Code:
    If Weekday(Date) = vbMonday Then
        Worksheets("Report (2)").Name = Format(Date - 3, "dd.mm.yyyy")
    Else
        Worksheets("Report ICR (2)").Name = Format(Date - 1, "dd.mm.yyyy")
    End If

assuming "Report (2)" or "Report ICR (2)" is the current name of the sheet.
 
Upvote 0

Forum statistics

Threads
1,214,832
Messages
6,121,851
Members
449,051
Latest member
excelquestion515

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