Loop through folders and subfolders & copy and paste data from specific sheet and cells to another sheet

[mik1996]

Hi,

I have a really basic but important task that involves copying and pasting data from a daily worksheet into another worksheet each day.
I was wondering if its possible using vba could a macro loop through all the folders and subfolders in a directory to then find and copy and paste the cells into another sheet, the issue i found is that the daily worksheet is in a daily folder which changes each month, please see below:
K:\Finance\Protected Funding Sheets\Barclays cash funding\Daily Funding Calculation\2023\04. April\24 April 2023 BCA CSH Daily.xlsx


I basically need to copy the data (highlighted yellow) (B1,C1,C16,F19-H20,K15,M15-O16,M19-O20) in this sheet named Journal below and paste it into a new sheet which gets updated every day.

I would ideally like it for the data to be pasted into a sheet like this below (or something similar) if that is possible at all

Any help on this at all would be really very much appreciated
Thanking you in advance,

Quote Reply
Report

 

[I_know_nuffin]

Hi

try the below

'/****************************************************************************************\

' paste into a module in your postings workbook
' step through the code with the F8 Key
' you will need to add the other cell referances to the below where it states
' add the other required cells

' it finds the current year folder
' then the cuurrent month folder in the year
' then the latest file in the current month

'\****************************************************************************************/


 
Sub getlatestfilename()
  Dim F As String, folder As String, currentyear As Integer, currentmonth As String, foldername As String, myfile As String
  Dim LatestFile As String, filetoopen As String
  Dim LatestDate As Date
  Dim LMD As Date
  Dim LR As Long
  Dim datawb As Workbook, thiswb As Workbook, ws As Worksheet
  
  ' uncomment below once happy it runs
  'Application.ScreenUpdating = False
  
  
  Set thiswb = ActiveWorkbook
  
  currentyear = Year(Date)
  currentmonth = Format(Month(Date), "00")
  
  
  
  folder = "K:\Finance\Protected Funding Sheets\Barclays cash funding\Daily Funding Calculation\" & currentyear '& "\"
  
  F = Dir(folder & "\*", vbDirectory)
  Do While F <> ""
    If InStr(F, currentmonth) > 0 Then
        foldername = F
        'Debug.Print foldername
        folder = folder & "\" & foldername & "\"
        Exit Do
    End If
    F = Dir
  Loop
  
  ' check the month folder has been found
  If F = "" Then
    MsgBox "No " & currentmonth & " folder found..... ", vbExclamation
    Exit Sub
  End If
  'Debug.Print folder
      
    
    'Make sure that the path ends in a backslash
    If Right(folder, 1) <> "\" Then folder = folder & "\"
    
    'Get the first Excel file from the folder
    myfile = Dir(folder & "*.xlsx", vbNormal)
    
    'If no files were found, exit the sub
    If Len(myfile) = 0 Then
        MsgBox "No files were found...", vbExclamation
        Exit Sub
    End If
    
    'Loop through each Excel file in the folder
    Do While Len(myfile) > 0
    
        'Assign the date/time of the current file to a variable
        LMD = FileDateTime(folder & myfile)
        
        'If the date/time of the current file is greater than the latest
        'recorded date, assign its filename and date/time to variables
        If LMD > LatestDate Then
            LatestFile = myfile
            LatestDate = LMD
        End If
        
        'Get the next Excel file from the folder
        myfile = Dir
        
    Loop
    
    'Debug.Print LatestFile, LatestDate,
    
    filetoopen = folder & LatestFile
    
    'Debug.Print filetoopen
    Set datawb = Workbooks.Open(filetoopen)
    
    'select the correct sheet
    'change sheetname to what is used in the file
    'datawb.Sheets("sheetname").Activate
    
    With datawb.Sheets("Journal")
    date1 = .Range("B1")
    date2 = .Range("C1")
    bca = .Range("C16")
    bcabs41 = .Range("H19")
    bcabs42 = .Range("H20")
    'add the other required cells
    End With
    
    
    datawb.Close savechanges = False
    Set ws = thiswb.Sheets("Postings")
    ws.Activate
    
    'For understanding LR = Last Row
    'add variables data to the last row + 1
     With ws
     LR = .Cells(Rows.Count, 1).End(xlUp).Row
    'add the saved variables
    .Cells(LR + 1, 1) = date1
    .Cells(LR + 1, 2) = date2
    .Cells(LR + 1, 3) = bca
    .Cells(LR + 1, 4) = bcabs41
    .Cells(LR + 1, 5) = bcabs42
    'add the other required cells
    End With
    
    Application.ScreenUpdating = True
End Sub

 

[mik1996]

Hi

try the below

'/****************************************************************************************\

' paste into a module in your postings workbook
' step through the code with the F8 Key
' you will need to add the other cell referances to the below where it states
' add the other required cells

' it finds the current year folder
' then the cuurrent month folder in the year
' then the latest file in the current month

'\****************************************************************************************/


 
Sub getlatestfilename()
  Dim F As String, folder As String, currentyear As Integer, currentmonth As String, foldername As String, myfile As String
  Dim LatestFile As String, filetoopen As String
  Dim LatestDate As Date
  Dim LMD As Date
  Dim LR As Long
  Dim datawb As Workbook, thiswb As Workbook, ws As Worksheet
 
  ' uncomment below once happy it runs
  'Application.ScreenUpdating = False
 
 
  Set thiswb = ActiveWorkbook
 
  currentyear = Year(Date)
  currentmonth = Format(Month(Date), "00")
 
 
 
  folder = "K:\Finance\Protected Funding Sheets\Barclays cash funding\Daily Funding Calculation\" & currentyear '& "\"
 
  F = Dir(folder & "\*", vbDirectory)
  Do While F <> ""
    If InStr(F, currentmonth) > 0 Then
        foldername = F
        'Debug.Print foldername
        folder = folder & "\" & foldername & "\"
        Exit Do
    End If
    F = Dir
  Loop
 
  ' check the month folder has been found
  If F = "" Then
    MsgBox "No " & currentmonth & " folder found..... ", vbExclamation
    Exit Sub
  End If
  'Debug.Print folder
     
   
    'Make sure that the path ends in a backslash
    If Right(folder, 1) <> "\" Then folder = folder & "\"
   
    'Get the first Excel file from the folder
    myfile = Dir(folder & "*.xlsx", vbNormal)
   
    'If no files were found, exit the sub
    If Len(myfile) = 0 Then
        MsgBox "No files were found...", vbExclamation
        Exit Sub
    End If
   
    'Loop through each Excel file in the folder
    Do While Len(myfile) > 0
   
        'Assign the date/time of the current file to a variable
        LMD = FileDateTime(folder & myfile)
       
        'If the date/time of the current file is greater than the latest
        'recorded date, assign its filename and date/time to variables
        If LMD > LatestDate Then
            LatestFile = myfile
            LatestDate = LMD
        End If
       
        'Get the next Excel file from the folder
        myfile = Dir
       
    Loop
   
    'Debug.Print LatestFile, LatestDate,
   
    filetoopen = folder & LatestFile
   
    'Debug.Print filetoopen
    Set datawb = Workbooks.Open(filetoopen)
   
    'select the correct sheet
    'change sheetname to what is used in the file
    'datawb.Sheets("sheetname").Activate
   
    With datawb.Sheets("Journal")
    date1 = .Range("B1")
    date2 = .Range("C1")
    bca = .Range("C16")
    bcabs41 = .Range("H19")
    bcabs42 = .Range("H20")
    'add the other required cells
    End With
   
   
    datawb.Close savechanges = False
    Set ws = thiswb.Sheets("Postings")
    ws.Activate
   
    'For understanding LR = Last Row
    'add variables data to the last row + 1
     With ws
     LR = .Cells(Rows.Count, 1).End(xlUp).Row
    'add the saved variables
    .Cells(LR + 1, 1) = date1
    .Cells(LR + 1, 2) = date2
    .Cells(LR + 1, 3) = bca
    .Cells(LR + 1, 4) = bcabs41
    .Cells(LR + 1, 5) = bcabs42
    'add the other required cells
    End With
   
    Application.ScreenUpdating = True
End Sub

thanks very much for this, this is exactly what i needed. i completely forgot to mention that there is a password on the workbooks (BCA CSH Daily) the password is 'barclays' all lower case, is there anyway possible i can amend the coding to automatically enter the password and also is it possible to copy and paste the data without opening the workbook if that is at all possible? thanks again for creating its very appreciated

 

[I_know_nuffin]

Hi
Will see what I can do but off work now till Monday

 

[mik1996]

Hi
Will see what I can do but off work now till Monday

no problem at all, thanks very much for helping me with this

 

[I_know_nuffin]

no problem at all, thanks very much for helping me with this

Hi

if you change the line
Set datawb = Workbooks.Open(filetoopen)

to the below with the correct password it should work

' open password protected file
Set datawb = Workbooks.Open(filetoopen, Password:="password")


As to not opening the file I cant see a way to do this on password protected files

but if you uncomment the line
Application.ScreenUpdating = False

then you should never see the file open

hope this helps

 

[mik1996]

Hi

if you change the line
Set datawb = Workbooks.Open(filetoopen)

to the below with the correct password it should work

' open password protected file
Set datawb = Workbooks.Open(filetoopen, Password:="password")


As to not opening the file I cant see a way to do this on password protected files

but if you uncomment the line
Application.ScreenUpdating = False

then you should never see the file open

hope this helps

 

[mik1996]

Thanks very much for this, it works perfectly, sorry just one more quick question, how would i ammend the coding so that it doesn't save the file when it opens and copies the data over? is that something that can be tweaked? its not mega important if it can't be

Cheers

 

[I_know_nuffin]

the line in the code should close the file without saving

datawb.Close savechanges = False

it might might need to be

datawb.Close savechanges := False