How to list&display all files in user folder,select file,copy specific tab into master sheet

How to list & display all files in user folder, select file and copy specific tab into master sheet

Requirement:

The user has to collate data in daily spreadsheets. The user has tried using formulas but the data changes daily so formulas do not work. From a master file the user wanted to create a macro that would give a list specific files in user folder (download folder) and select the correct file and then go to a tab in that file with content specific character called "QRSIS", copy this tab return to the master file and paste into master tab by replacing any existing data.

Note: master file is a common/public file, different user will use but the file folder will be the same, its under download folder.

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1214091-list-display-all-files-in-user-folder-select-file-copy-specific-tab-into-master-sheet

Solution:

Code:

Sub Main()
  Dim a, e, ws1 As Worksheet, ws2 As Worksheet
  Dim tf As Boolean
  
  'Get full file name(s)
  a = MSFiles(CurrentUserDownloadsFolder & "QRSIS*")
  If Not IsArray(a) Then Exit Sub
  'MsgBox Join(a, vbLf)
  
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  
  Set ws1 = ThisWorkbook.Worksheets(1)
  ws1.UsedRange.ClearContents
  
  For Each e In a
    Set ws2 = GetObject(e).Worksheets(1)
    If Not tf Then
      ws2.UsedRange.Copy ws1.[A1]
      tf = True
      Else
      ws2.UsedRange.Copy ws1.Cells(Rows.Count, "A").End(xlUp).Offset(1)
    End If
    ws2.Parent.Close
  Next e
  
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
End Sub


Function MSFiles(initialFilename$, Optional Title$ = "Select File(s)", _
  Optional FilterDescription$ = "XLS", _
  Optional FilterExtensions$ = "*.xls")
  Dim x, i As Long
  With Application.FileDialog(msoFileDialogOpen)
    .ButtonName = "&Open"
    .initialFilename = initialFilename
    'Change the contents of the Files of Type list.
        'Empty the list by clearing the FileDialogFilters collection.
        .Filters.Clear
        'Add a filter that includes all files.
    '.Filters.Add "All files", "*.*" 'Usually first...
    '.Filters.Add "Excel (*.xls)", "*.xls", 1
    '.Filters.Add "Excel", "*.xls; *.xlsx; *.xlsm", 1
    .Filters.Add FilterDescription, FilterExtensions, 1
    .Title = Title
    .AllowMultiSelect = True
    If .Show = -1 Then
      ReDim x(1 To .SelectedItems.Count)
      For i = 1 To .SelectedItems.Count
        x(i) = .SelectedItems(i)
      Next i
      MSFiles = x
    End If
  End With
End Function

'Default location, VBA.Environ$("USERPROFILE") & "\Downloads\"
Function CurrentUserDownloadsFolder() As String
  CurrentUserDownloadsFolder = Replace(CreateObject("WScript.Shell").RegRead( _
    "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\" & _
    "{374DE290-123F-4565-9164-39C4925E467B}"), "%USERPROFile%", VBA.Environ("USERPROFILE")) & "\"
End Function

Obtained from the OzGrid Help Forum.

Solution provided by Kenneth Hobson.