How to list & display all files in user folder, select file and copy specific tab into master sheet
Category: [Excel] Demo Available
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.
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.
See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets
See also:
| How to select multiple worksheets and copy to desktop folder |
| How to create VBA to save reports, generated using macros to specific folders |
| How to search in subfolders and word documents |
| How to use VBA script to count files/subfolders using a range from WB for the root folder |
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.