macro to select path to collect data from

Hi , i have a macro , done with the help of this forum that colects data from seeveral files in one folder that is hard coded in the macro, what i would like now is to have the possibility to select the working folder to work
attatched the files i have now

The macro i have is

Sub CollectInfo()
'Author:    Jerry Beaucaire, ExcelForum.com
'Date:      10/21/2010
'Summary:   Collect specific data from all workbooks in a single folder
Dim fPath As String:        fPath = "C:\2010\Test\"      'where files are found
Dim fName As String
Dim wbData As Workbook
Dim wsDest As Worksheet:    Set wsDest = ThisWorkbook.Sheets("stock")
Dim NR As Long:             NR = wsDest.Range("B" & Rows.Count).End(xlUp).Row + 1
Dim LR As Long

Application.ScreenUpdating = False      'speed up macro
fName = Dir(fPath & "*.xls")            'filter for files to open

Do While Len(fName) > 0
    Set wbData = Workbooks.Open(fPath & fName)  'open found file
    With wbData.Sheets("Resumo")
        .Rows(10).AutoFilter
        .Rows(10).AutoFilter Field:=6, Criteria1:=">0.5"
        LR = .Range("A" & .Rows.Count).End(xlUp).Row
        If LR > 10 Then
            wsDest.Range("A" & NR).Value = .[A5]
            wsDest.Range("E" & NR).Value = .[D2]
            .Range("A11:A" & LR & ",F11:F" & LR & ",K11:K" & LR).Copy
            wsDest.Range("B" & NR).PasteSpecial xlPasteValuesAndNumberFormats
            wsDest.Range("F" & NR).Value = .[C*E]
            
        End If
    End With
    wbData.Close False
    NR = Range("B" & Rows.Count).End(xlUp).Row + 1
    fName = Dir
Loop

LR = Range("B" & Rows.Count).End(xlUp).Row
With Range("A1:E" & LR)
    .SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
    .Value = .Value
End With

Run [teorico()]
Run [real()]

Columns.AutoFit
Application.ScreenUpdating = True



End Sub