# Macro to copy cells from multiple excels in a folder that changes name daily



## cdalgorta (Dec 26, 2022)

Happy holidays! And thank you in advance!

In summary: I need a macro that would *copy *all the columns A:C starting from Row 2 if the sheet name is "Apply" or "apply", of all the excels in a *specific folder*. I need to paste all these values on another Excel.

Example:

Specific folder(changes daily):



 

I need to copy A:C starting from Row 2 of all the excels in the above folder(If the sheet name is "Apply" or "apply").






I need to paste them(as value) all in the below excel(name changes daily). On the sheet name "Paid Invoices" and paste them on the same cells "A:C" all the way down:




By the way, I'm not sure how much more complicated it would be to make a macro for this because of the *folder name* I need to *copy from changes daily*, so if that's the complicated part, I wouldn't mind having to copy/paste all the excels from the changing folder into a standard folder in my desktop(name can be "Daily Change"). 





Action:

In a perfect world(hahah), I'd say that what I'd need is to open this Excel:




Click on the macro, and the macro would first ask me to choose the folder from which I want to copy from and I'd choose the one I need:




The macro would then do the rest by copying and pasting(as value) the cells that I need. A:C starting from row 2 of sheet named "Apply" or "apply.




Thank you!

P.S. I can have the macro on the personal macro workbook, or it would probably be better if I can have it on the excel that is getting the information pasted on. In this example, it would be in this one:



The above is always a new copy(with the new dates) of the primary template(below). So I could paste the VBA on the template macro.


----------



## breynolds0431 (Dec 26, 2022)

Hi there. This should do it when added to a new normal module of the destination workbook, which would be your "ACH 12.27 (12.23 info).xlsm" file. 

As explained below, I assumed that the lookback into the invoice folder is always four days as your example has the paste to workbook as 12/27 and the invoice folder as 12/23. 


```
Sub ImportInvoices()

'declare Active WB (destination workbook) and Paid Invoices tab
Dim wb As Workbook: Set wb = ThisWorkbook
Dim pi As Worksheet: Set pi = wb.Sheets("Paid Invoices")

'determines correct month and year of folder to go through
'Note: The "- 4" is from the 12/27 to 12/23 example (i.e.; 4 day difference)
Dim iMon As Integer, iYear As Integer
If Not Month(Date - 4) = Month(Date) Then
    iMon = Month(Date) - 1
Else
    iMon = Month(Date)
End If
If Not Year(Date - 4) = Year(Date) Then
    iYear = Year(Date) - 1
Else
    iYear = Year(Date)
End If

'declare variables for folders (invoice path)
Dim iPath As String: iPath = "G:\Shared drives\AP-AR\AR\Bank Deposits\" & _
    iYear & "\" & iMon & "-" & iYear & "\" & "Remittances" & "\" & iMon & _
    "-" & Day(Date - 4) & " Remittances" & "\"

'Optimize processing
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

On Error GoTo ResetSettings

'set up loop through iPath
Dim iExt As String: iExt = "*.xls*"
Dim iFile As String: iFile = Dir(iPath & iExt)
Dim iWB As Workbook, iWBLR As Long, piLR As Long

'loop through each excel file in iPath
Do While iFile <> ""
    Set iWB = Workbooks.Open(Filename:=iFile, ReadOnly:=True)
    DoEvents
    
    If WSExists("Apply") = True Or WSExists("apply") = True Then
        'determine last row of Apply sheet and next open row of Paid Invoices (pi) sheet
        iWBLR = iWB.Sheets("Apply").Cells(iWB.Sheets("Apply").Rows.Count, 1).End(xlUp).Row
        piLR = pi.Cells(pi.Rows.Count, 1).End(xlUp).Row + 1
        'converts any formulas in range form Apply sheet to values
        Dim c As Range
        For Each c In iWB.Sheets("Apply").Range("A2:C" & iWBLR).Cells
            If c.HasFormula Then c.Formula = c.Value
        Next c
        'copies range from Apply sheet to Paid Invoices sheet
        iWB.Sheets("Apply").Range("A2:C" & iWBLR).Copy pi.Cells(piLR, 1)
    End If
    
    DoEvents
    iWB.Close savechanges:=False
    iFile = Dir
Loop

'Restores settings
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

'Task completion message
MsgBox "The task has completed.", vbInformation, "Task Completion"

Exit Sub

'Error Handling
ResetSettings:
MsgBox "The below error has occurred: " & vbCrLf & vbCrLf & "Error Number:" & Err.Number & vbCrLf & _
    "Error Description: " & Err.Description
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Function WSExists(SheetName As String) As Boolean
    
Dim TempSheetName As String

TempSheetName = UCase(SheetName)

WSExists = False
    
For Each Sheet In Worksheets
    If TempSheetName = UCase(Sheet.Name) Then
        WSExists = True
        Exit Function
    End If
Next Sheet

End Function
```


----------



## cdalgorta (Dec 26, 2022)

Hi. Thank you for the quick reply!
I got this error. Is it because some files have parenthesis?





Also, is not always 4 days. It's pretty much the next day the bank is open. So if it's tomorrow for wednesday, then the file name would be "ACH 12.28 (12.27 info).xlsm". Except Fridays(3 day difference), the other days is always 1 day difference(today banks are close so it ended up being 4 days).
Would I just need to change the *below *part to "-1" to make it work and then change it to "-3" on Fridays?


```
'determines correct month and year of folder to go through
'Note: The "- 4" is from the 12/27 to 12/23 example (i.e.; 4 day difference)
Dim iMon As Integer, iYear As Integer
If Not Month(Date - 4) = Month(Date) Then    'Change to -1 Mon to Th and -3 on Fri
    iMon = Month(Date) - 1
Else
    iMon = Month(Date)
End If
If Not Year(Date - 4) = Year(Date) Then           'Change to -1 Mon to Th and -3 on Fri
    iYear = Year(Date) - 1
Else
    iYear = Year(Date)
End If
```


----------



## cdalgorta (Dec 26, 2022)

Actually, I just realized that it grabbed a file from the 12-22 folder instead of the 12-23 folder.


----------



## breynolds0431 (Dec 26, 2022)

Okay, we can use the workday function to determine the previous workday. As for the file error, I found an issue with the workbooks.open part, which was missing the folder path.

The previous workday option might not be the best when considering holidays. A range of holidays could be added somewhere in your file where the previous workday would then consider holidays. Or, using the folder picker dialog to manually select the correct folder would be another option. Let me know how the below works or if you'd just like to manually pick the correct folder every time. 


```
Sub ImportInvoices()

'declare Active WB and Paid Invoices tab
Dim wb As Workbook: Set wb = ThisWorkbook
Dim pi As Worksheet: Set pi = wb.Sheets("Paid Invoices")

'determines the previous workday
Dim lb As Date: lb = CDate(Evaluate("WORKDAY(TODAY(),-1)"))

'declare variables for folders (invoice path)
Dim iPath As String: iPath = "G:\Shared drives\AP-AR\AR\Bank Deposits\" & _
    Year(lb) & "\" & Month(lb) & "-" & Year(lb) & "\" & "Remittances" & "\" _
    & Month(lb) & "-" & Day(lb) & " Remittances" & "\"

'Optimize processing
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

On Error GoTo ResetSettings

'set up loop through iPath
Dim iExt As String: iExt = "*.xls*"
Dim iFile As String: iFile = Dir(iPath & iExt)
Dim iWB As Workbook, iWBLR As Long, piLR As Long

'loop through each excel file in iPath
Do While iFile <> ""
    Set iWB = Workbooks.Open(Filename:=iPath & iFile, ReadOnly:=True)
    DoEvents
    
    If WSExists("Apply") = True Or WSExists("apply") = True Then
        'determine last row of Apply sheet and next open row of Paid Invoices (pi) sheet
        iWBLR = iWB.Sheets("Apply").Cells(iWB.Sheets("Apply").Rows.Count, 1).End(xlUp).Row
        piLR = pi.Cells(pi.Rows.Count, 1).End(xlUp).Row + 1
        'converts any formulas in range form Apply sheet to values
        Dim c As Range
        For Each c In iWB.Sheets("Apply").Range("A2:C" & iWBLR).Cells
            If c.HasFormula Then c.Formula = c.Value
        Next c
        'copies range from Apply sheet to Paid Invoices sheet
        iWB.Sheets("Apply").Range("A2:C" & iWBLR).Copy pi.Cells(piLR, 1)
    End If
    
    DoEvents
    
    iWB.Close savechanges:=False
    iFile = Dir

Loop

'Restores settings
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

'Task completion message
MsgBox "The task has completed.", vbInformation, "Task Completion"

Exit Sub

'Error Handling
ResetSettings:
MsgBox "The below error has occurred: " & vbCrLf & vbCrLf & "Error Number:" & Err.Number & vbCrLf & _
    "Error Description: " & Err.Description
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Function WSExists(SheetName As String) As Boolean
    
Dim TempSheetName As String

TempSheetName = UCase(SheetName)

WSExists = False
    
For Each Sheet In Worksheets
    If TempSheetName = UCase(Sheet.Name) Then
        WSExists = True
        Exit Function
    End If
Next Sheet

End Function
```


----------



## cdalgorta (Dec 26, 2022)

This worked perfectly! I made a sheet with the holidays, and tried to changed the below to add the list of holidays, but got a big error hahah  



Tried changing this:

```
'determines the previous workday
Dim lb As Date: lb = CDate(Evaluate("WORKDAY(TODAY(),-1)"))
```

to this

```
Dim lb As Date: lb = CDate(Evaluate("=WORKDAY(TODAY(),-1,Hol!R2C2:R12C3)"))
```


And got error





Also, could you give me the option to get the "folder picker dialog to manually select the correct folder" please?
I just realized that the previous VBA will only work if I run it on the business day *after *the folder name date, but I *sometimes *work on it on the same day as the folder name to advance with my work at night(like the example I gave you, it's for the 27th, but I advanced it on the 23rd). It's called 27th because I cannot apply it in our system until that day, but the excel I can have it ready in advance which I like to do in the evening of the previous day hahah. This is why I think choosing the folder would probably be better. Sorry for the inconvenience!


----------



## breynolds0431 (Dec 26, 2022)

The below should allow you to use the folder picker option. For the workday formula, not sure if evaluate doesn't like the R1C1 style reference, but I was able to get it with the A1 style.


```
Sub ImportInvoices()

'declare Active WB and Paid Invoices tab
Dim wb As Workbook: Set wb = ThisWorkbook
Dim pi As Worksheet: Set pi = wb.Sheets("Paid Invoices")
'declares folder picker as a variable
Dim fPicker As FileDialog: Set fPicker = Application.FileDialog(msoFileDialogFolderPicker)

With fPicker
    .AllowMultiSelect = False
    .Title = "Select Invoice Folder"
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
End With

'Optimize processing
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

On Error GoTo ResetSettings

'set up loop through iFolder
Dim iFolder As String: iFolder = fPicker.SelectedItems(1) & "\"
Dim iExt As String: iExt = "*.xls*"
Dim iFile As String: iFile = Dir(iFolder & iExt)
Dim iWB As Workbook, iWBLR As Long, piLR As Long

'loop through each excel file in iFolder
Do While iFile <> ""
    Set iWB = Workbooks.Open(Filename:=iFolder & iFile, ReadOnly:=True)
    DoEvents
   
    If WSExists("Apply") = True Or WSExists("apply") = True Then
        'determine last row of Apply sheet and next open row of Paid Invoices (pi) sheet
        iWBLR = iWB.Sheets("Apply").Cells(iWB.Sheets("Apply").Rows.Count, 1).End(xlUp).Row
        piLR = pi.Cells(pi.Rows.Count, 1).End(xlUp).Row + 1
        'converts any formulas in range form Apply sheet to values
        Dim c As Range
        For Each c In iWB.Sheets("Apply").Range("A2:C" & iWBLR).Cells
            If c.HasFormula Then c.Formula = c.Value
        Next c
        'copies range from Apply sheet to Paid Invoices sheet
        iWB.Sheets("Apply").Range("A2:C" & iWBLR).Copy pi.Cells(piLR, 1)
    End If
   
    DoEvents
    iWB.Close savechanges:=False
    iFile = Dir
Loop

'Restores settings
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

'Task completion message
MsgBox "The task has completed.", vbInformation, "Task Completion"

Exit Sub

'Error Handling
ResetSettings:
MsgBox "The below error has occurred: " & vbCrLf & vbCrLf & "Error Number:" & Err.Number & vbCrLf & _
    "Error Description: " & Err.Description
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Function WSExists(SheetName As String) As Boolean
   
Dim TempSheetName As String

TempSheetName = UCase(SheetName)

WSExists = False
   
For Each Sheet In Worksheets
    If TempSheetName = UCase(Sheet.Name) Then
        WSExists = True
        Exit Function
    End If
Next Sheet

End Function
```


----------



## cdalgorta (Dec 26, 2022)

Thank you so much! It works so well! This will save me 30-45 minutes daily of dozens and dozens of opening and closing files. 😭
Thank you again! And happy holidays! 🎄


----------

