Hello,
I use the macro below to loop through all the xlsx files with a certain name in a folder and to copy paste data from a sheet called Exchange rates into a Sheet1 of the the master file (Thisworkbook).
There are many different files in the folder, however I am only interested in those called "NAV_PACK_L3264_YYYYMMDD", which are automatically saved in that location on a daily basis.
So far I managed to retrieve the data from all the files for 2020 (If Left(strFile, 19) = "NAV_PACK_L3264_2020" Then), however what I would really like to achieve is extracting the information only for a specific quarter plus the last day of the previous quarter. Example: for Q1 2020 I would need to extract the data from all daily reports from 31/12/2019 to 31/03/2020, for Q2 2020 I would need to extract the data from all daily reports from 31/03/2020 to 30/06/2020.
Is there any way I could accomplish this? In addition, the macro is extremely slow... Thanks for your help.
I use the macro below to loop through all the xlsx files with a certain name in a folder and to copy paste data from a sheet called Exchange rates into a Sheet1 of the the master file (Thisworkbook).
There are many different files in the folder, however I am only interested in those called "NAV_PACK_L3264_YYYYMMDD", which are automatically saved in that location on a daily basis.
So far I managed to retrieve the data from all the files for 2020 (If Left(strFile, 19) = "NAV_PACK_L3264_2020" Then), however what I would really like to achieve is extracting the information only for a specific quarter plus the last day of the previous quarter. Example: for Q1 2020 I would need to extract the data from all daily reports from 31/12/2019 to 31/03/2020, for Q2 2020 I would need to extract the data from all daily reports from 31/03/2020 to 30/06/2020.
Is there any way I could accomplish this? In addition, the macro is extremely slow... Thanks for your help.
VBA Code:
Option Explicit
Sub ImportExcelfiles()
Dim strPath As String
Dim strFile As String
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim rowCountSource As Long
Dim colCountSource As Long
Dim rowOutputTarget As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'============================
'EDIT THE PATH TO THE FOLDER
'============================
strPath = "C: \MyPath\"
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
'set the target worksheet
Set wsTarget = ThisWorkbook.Worksheets("Sheet1")
'set the initial output row
rowOutputTarget = 2
'get the first file
strFile = Dir(strPath & "*.xlsx*")
'loop throught the excel files in the folder
Do While strFile <> ""
If Left(strFile, 19) = "NAV_PACK_L3264_2020" Then
'open the workbook
Set wbSource = Workbooks.Open(strPath & strFile)
Set wsSource = wbSource.Worksheets("Exchange rates")
'get the row and column counts
With wsSource
'row count based on column 1 = A
rowCountSource = .Cells(.Rows.Count, 1).End(xlUp).Row
'column count based on row 1
colCountSource = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
'copy and paste from A2
wsSource.Range("C2", "F10").Copy
wsTarget.Range("A" & rowOutputTarget).PasteSpecial Paste:=xlPasteValues
'update output row
rowOutputTarget = rowOutputTarget + rowCountSource - 1
'close the opened workbook
wbSource.Close SaveChanges:=False
End If
'get the next file
strFile = Dir()
Loop
wsTarget.Range("$A$1:$D$500").AutoFilter Field:=2, Criteria1:=Array( _
"AUD", "CAD", "CHF", "EUR", "GBP", "JPY"), Operator:=xlFilterValues
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$1:$O$52").AutoFilter Field:=2
'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing
MsgBox ("Done")
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
