''ACCODA DATI
Option Explicit

Private Sub Sfoglia_Files()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' ATTENZIONE RICHIEDE L'ATTIVAZIONE DELLA LIBRERIA MICROSOFT SCRIPTING RUNTIME '''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim strPath As String
   
    Dim objFSY As FileSystemObject
    Dim objFOL As Folder
    Dim objFIL As File
    
    Dim wbFrom As Workbook, wbTo As Workbook
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Dim x As Long, i As Long
    Dim rngCopy As Range
    
    Set wbTo = ThisWorkbook
    Set wsTo = wbTo.Sheets(1)
     
    strPath = "C:ProveFiles" '''QUI IL PERCORSO
    
    Set objFSY = New FileSystemObject
    Set objFOL = objFSY.GetFolder(strPath)

    For Each objFIL In objFOL.Files
			x = wsTo.Range("B" & wsTo.Rows.Count).End(xlUp).Row + 1
			
			Set wbFrom = Application.Workbooks.Open(objFIL)
			Set wsFrom = wbFrom.Sheets(1)
				With wsFrom
					i = .Range("B" & .Rows.Count).End(xlUp).Row
					Set rngCopy = .Range("B3:Q" & i)
					rngCopy.Copy wsTo.Cells(x, 2)
					Set rngCopy = Nothing
				End With
			wbFrom.Close 0
			Set wbFrom = Nothing
			Set wsFrom = Nothing
    Next

    Set objFSY = Nothing
    Set objFOL = Nothing
    Set wbTo = ThisWorkbook
    Set wsTo = Nothing
End Sub