Consolidation of Data from folders and subfolders using recursion

Option Explicit
Dim wb As Workbook
Dim lr As Long
Dim lrt As Long
Sub GetAllFiles()

    Dim Directory As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Select a location containing the files you want to list."
        .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            Directory = .SelectedItems(1) & "\"
        End If
    End With
 
    Cells.ClearContents
    Call RecursiveDir(Directory)
End Sub

Public Sub RecursiveDir(ByVal CurrDir As String)
    Dim Dirs() As String
    Dim NumDirs As Long
    Dim FileName As String
    Dim PathAndName As String
    Dim i As Long
    Dim Filesize As Double

'   Make sure path ends in backslash
    If Right(CurrDir, 1) <> "\" Then CurrDir = CurrDir & "\"

'   Get files
    On Error Resume Next
    FileName = Dir(CurrDir & "*.*", vbDirectory)
    Do While Len(FileName) <> 0
      If Left(FileName, 1) <> "." Then 'Current dir
        PathAndName = CurrDir & FileName
        If (GetAttr(PathAndName) And vbDirectory) = vbDirectory Then
          'store found directories
           ReDim Preserve Dirs(0 To NumDirs) As String
           Dirs(NumDirs) = PathAndName
           NumDirs = NumDirs + 1
        Else
  Set wb = Workbooks.Open(PathAndName)
   lr = ActiveWorkbook.Worksheets("Sheet1").Range("A1048576").End(xlUp).Row
   Range("A2:D" & lr).Copy
   lrt = ThisWorkbook.Worksheets("Sheet1").Range("A1048576").End(xlUp).Row + 1
   ThisWorkbook.Worksheets("Sheet1").Range("A" & lrt).PasteSpecial xlPasteAll
   wb.Close
   End If
    End If
        FileName = Dir()
    Loop
    ' Process the found directories, recursively
    For i = 0 To NumDirs - 1
        RecursiveDir Dirs(i)
    Next i
End Sub