While Consolidating the Data from different workbooks, Required Folder Selection as well

[Balakrishnan2027]

I am currently using the below code, to consolidate the data from diffrent workbooks. In this instead of standard path, I need to change the path to dynamic. Pls help

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Master")
    Const strPath As String = "C:\Users\1530959\Desktop\Bala\Macro\"
    ChDir strPath
   
    'clear the existting values in summary sheet
    Sheets("Master").Select
    Rows("2:500000").Select
    Selection.ClearContents
    Application.DisplayAlerts = False

    strExtension = Dir("*.xlsx*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("Consol").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("Consol").Range("A2:D" & LastRow).Copy wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
    End With
    strExtension = Dir
    Loop
   
    ws.Activate
    On Error Resume Next
        ws.ShowAllData
    On Error GoTo 0
   
    ws.Range("A2:A500000").AutoFilter Field:=1, Criteria1:="#VALUE"
    Application.DisplayAlerts = False
        ws.Range("A2:A500000").SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    On Error Resume Next
        ws.ShowAllData
    On Error GoTo 0
   
   
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

In what way does it need to be dynamic?

 

[Balakrishnan2027]

Currently it was taking the files from the path "C:\Users\Desktop\Bala\Macro\". Instead, I want to select the folder every time.

 

[Fluff]

Ok how about

    Set ws = ThisWorkbook.Worksheets("Master")
    Dim strPath As String
    
    With Application.FileDialog(4)
      .AllowMultiSelect = False
      If .Show Then strPath = .SelectedItems(1)
   End With
      
   If strPath = "" Then Exit Sub
   strPath = strPath & Application.PathSeparator
      
   
    'clear the existting values in summary sheet

 

[Balakrishnan2027]

Thanks Bro. But It was not working

 

[Fluff]

In what way?