Change folder path location - dynamic - so i can choose or pick multiple excel files

[ajayfbd]

Hello everyone - i have found below VBA code for Copy data from multiple workbooks in this forum which is perfectly ok
now i just want to change folder path because my folder is not on same location
please help me to change folder path location - dynamic - so i can choose or pick multiple excel files

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
  Const strPath As String = " C:\Users\xbv\Desktop\group1\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("appendix B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("appendix B").Range("C6:F" & LastRow).Copy wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[daverunt]

Hi

I use the following to select multiple .csv files in a folder of my choosing. You can change the extn.

'Display Open Dialog to select file directory
filenames = Application.GetOpenFilename("Excel Files (*.csv*)," & _
"*.csv*", 1, "select csv files", "Open", True)

'If the user Cancels file selection then exit
If TypeName(filenames) = "Boolean" Then
Exit Sub
End If

   For i = 1 To UBound(filenames)

   Workbooks.Open filenames(i)
   Set CSVFile = ActiveWorkbook

   ~~~~~~


   Next i

 

[ajayfbd]

dear sir, how can i use this code with my above code

 

[ajayfbd]

i need to copy paste data specific range from multiple workbook in to a master workbook, please refer my code for details

 

[daverunt]

Sorry. Been away.
Try the following. It should process the files you select.

Sub CopyRange()
Application.ScreenUpdating = False
Dim wkbDest As Workbook
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Dim LastRow As Long


filenames = Application.GetOpenFilename("Excel Files (*.xls*)," & _
"*.xls*", 1, "select xls files", "Open", True)

'If the user Cancels file selection then exit
If TypeName(filenames) = "Boolean" Then
Exit Sub
    End If

   For i = 1 To UBound(filenames)

   Set wkbSource = Workbooks.Open(filenames(i))

    With wkbSource
            LastRow = .Sheets("appendix B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets("appendix B").Range("C6:F" & LastRow).Copy wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
      End With


Next i
Application.ScreenUpdating = True
End Sub