VBA Macro - Fastest way to get Data from all files in a folder

Hello friends, all relevant materials for this topic/tutorial can be downloaded from here. Please support us by subscribing to our channel and sharing them with your friends.

If you have any questions/feedback/tutorial request, please you can email me directly vbaa2z.team@gmail.com or comment on YouTube Video (blog comments are not actively monitored).

Tutorial link: https://youtu.be/m_eRv2m8L8s

Option Explicit

'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/dir-function
'Returns a String representing the name of a file, directory, or folder that matches a
'specified pattern or file attribute, or the volume label of a drive.
'https://youtu.be/m_eRv2m8L8s
Public i As Long

Sub c_test()

'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on how to use this code.
'Feel free to update the code as per your need and also share with your friends.
'Download free codes from http://vbaa2z.blogspot.com
'Support our channel: youtube.com/vbaa2z
'Author: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

Dim startTime As Date
Dim totaltime As Date

startTime = Now()

Application.ScreenUpdating = False
i = 0
Call FilesInDir("D:\VbaA2z\Projects Notes\Consolidate\RawData", "xls")
Application.ScreenUpdating = True

totaltime = Now() - startTime

Debug.Print Format(totaltime, "hh.mm.ss")


End Sub

Function FilesInDir(inFolder, fileExt) As String
Dim StrFile As String

StrFile = Dir(inFolder & "\*" & fileExt)

Do While Len(StrFile) > 0
    'Debug.Print inFolder & "\" & StrFile
    get_data inFolder & "\" & StrFile
    i = i + 1
    Application.StatusBar = i & ": " & inFolder & "\" & StrFile
    StrFile = Dir
Loop

End Function

'D:\VbaA2z\Projects Notes\Consolidate\RawData\au-500.csv

Function get_data(wb_path$) As Boolean

'-----------------------------
'Thanks for downloading the code. 
'Please visit our channel for a quick explainer on this code.
'Feel free to update the code as per your need and also share with your friends.
'Channel: Youtube.com/vbaa2z
'Download free codes from http://vbaa2z.blogspot.com
'Autor: L Pamai (vbaa2z.team@gmail.com)
'-----------------------------

    Dim dslr As Long, new_lr As Long, paste_des_row As Long
    Dim copyrange As Range
    Dim tagRng As Range
    
    Dim wb As Workbook

    Set wb = Workbooks.Open(wb_path, False, True)
    

    With wb
        dslr = .Sheets("YOUR SHEET NAME").Range("C" & Rows.Count).End(xlUp).Row
        Set copyrange = .Sheets("YOUR SHEET NAME").Range("A2:L" & dslr)
        copyrange.Copy
        
    End With
    
    
    With ThisWorkbook
        
        paste_des_row = .Sheets("Clients_Tb").Range("C" & Rows.Count).End(xlUp).Row + 1
        
        .Sheets("Clients_Tb").Range("B" & paste_des_row).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        
        new_lr = .Sheets("Clients_Tb").Range("C" & Rows.Count).End(xlUp).Row
        
        Set tagRng = .Sheets("Clients_Tb").Range(Range(Cells(paste_des_row, 1), Cells(new_lr, 1)).Address)
        
        tagRng.Value = wb.Name
        
        Application.CutCopyMode = False
        
        Set tagRng = Nothing
        
    End With
    
    Set copyrange = Nothing
    wb.Close False
    Set wb = Nothing
    
End Function