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

Sub unionefile()
'
' unionefile Macro
'
' Scelta rapida da tastiera: CTRL+h
'Sub Copia_Dati_da_più_File()
    Dim File_El As String, MiaDir As String, Perc_Stor  As String, File_Cop As Integer
    Dim Nome_Iniziale As String, Nome_Attuale As String, RR As Integer, I As Integer, J As Integer, Righe As Integer
    Dim WS_In As String, WS_Out As String
    
    Application.ScreenUpdating = False
    Nome_Iniziale = ActiveWorkbook.Name
    WS_Out = ActiveSheet.Name
    
' attenzione a mettere le "" finali !!!
    MiaDir = "C:Moduli_Ricevuti" ' ----->> ADATTA i nomi
    Perc_Stor = "Storico" ' ----->> ADATTA i nomi
    File_El = Dir(MiaDir & "*.xls")
    If File_El = "" Then
        MsgBox "ATTENZIONE: nel percorso   '" & MiaDir & "'   non sono stati trovati file"
        Exit Sub
    End If
    
    I = Workbooks(Nome_Iniziale).Sheets(WS_Out).Range("A" & Rows.Count).End(xlUp).Row + 1
    Righe = I
    File_Cop = 0
    While File_El <> ""
        Nome_Attuale = File_El
        Workbooks.Open Filename:=MiaDir & Nome_Attuale
        WS_In = Workbooks(Nome_Attuale).ActiveSheet.Name
        RR = Workbooks(Nome_Attuale).Sheets(WS_In).Range("A" & Rows.Count).End(xlUp).Row
        For J = 2 To RR
            Workbooks(Nome_Iniziale).Sheets(WS_Out).Cells(I, 1) = File_El
            Workbooks(Nome_Iniziale).Sheets(WS_Out).Cells(I, 2) = Date
            
'....................................................................................................................
' QUI vanno inserite le istruzioni per copiare i dati
' Nell'esempio vengono copiate le colonne A, B, C e D ---->> ADATTARE in base alle esigenze
            Workbooks(Nome_Iniziale).Sheets(WS_Out).Cells(I, 3) = Workbooks(Nome_Attuale).Sheets(WS_In).Cells(J, 1)
            Workbooks(Nome_Iniziale).Sheets(WS_Out).Cells(I, 4) = Workbooks(Nome_Attuale).Sheets(WS_In).Cells(J, 2)
            Workbooks(Nome_Iniziale).Sheets(WS_Out).Cells(I, 5) = Workbooks(Nome_Attuale).Sheets(WS_In).Cells(J, 3)
            Workbooks(Nome_Iniziale).Sheets(WS_Out).Cells(I, 6) = Workbooks(Nome_Attuale).Sheets(WS_In).Cells(J, 4)
'           ...
'....................................................................................................................
            
            I = I + 1
        Next J
        File_Cop = File_Cop + 1
        Windows(Nome_Attuale).Close
        On Error GoTo Errore
        Name MiaDir & Nome_Attuale As MiaDir & Perc_Stor & Nome_Attuale
        
        File_El = Dir
    Wend
    Application.ScreenUpdating = True
    MsgBox "Sono state copiate:  '" & I - Righe & "'  righe di dati" & vbCrLf & _
        "Presenti in:   '" & File_Cop & "'   File"
    Exit Sub
    
Errore:
    MsgBox "ATTENZIONE !!!" & vbCrLf & "Il File:   '" & Nome_Attuale & _
        "'" & vbCrLf & "E' stato già elaborato e storicizzato" & vbCrLf & vbCrLf & _
        "L'elaborazione viene interrotta !!!", vbCritical

End Sub

Private Sub Sfoglia_Files()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' ATTENZIONE RICHIEDE L'ATTIVAZIONE DELLA LIBRERIA MICROSOFT SCRIPTING RUNTIME '''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Application.DisplayAlerts = False
  Dim strPath As String
 
  Dim oFSY As FileSystemObject 'variabile oggetto della libreria indicata
  'h t t p: /  /msdn .m ic roso ft.com/ it-it/l ibrary/a a711216(v= vs.71).aspx
  
  Dim oFOL As Folder 'come sopra
  Dim oFIL As File 'idem con patate
  Dim oFD As FileDialog 'variabile oggetto, da guida in linea "un'istanza della finestra di dialogo dei file."
  'trattasi di proprietà dell'oggetto "application"
  Dim oScelta As Variant 'qui non so se sia la scelta migliore, serve per "catturare" la scelta fatta sul filedialog"
  
  Dim wbFrom As Workbook, wbTo As Workbook
  'due variabili workbook, una la istanzieremo su quello dove importare
  'l'altra diverrà di volta in volta il file che apriremo
  
  Dim wsFrom As Worksheet, wsTo As Worksheet
  'come sopra, ma due worksheet
  
  
  Dim x As Long, i As Long
  'serviranno per determinare da che riga a che riga copiare e dove incollare
  
  Dim rngCopy As Range
  
 
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  '- chiede di selezionare una directory in cui ci sono excel files '
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
  With oFD
    .InitialFileName = "C:" 'qui modificare eventuale cartella di default
    .Title = "Sfoglia cartelle"
    .ButtonName = "Ok"
    .AllowMultiSelect = False
    .InitialView = msoFileDialogViewDetails
    .Show
    For Each oScelta In .SelectedItems
      strPath = oScelta 'la variabile stringa diventa il percorso della cartella selezionata
    Next oScelta
  End With
  
  If strPath = "" Then GoTo Uscita
  
  Set wbTo = ThisWorkbook
  
  'istanziamo il foglio dove incollare i dati come il foglio "MAIN" come indicato
  Set wsTo = wbTo.Sheets("MAIN")
  
  Set oFSY = New FileSystemObject
  
  'sempre grazie alla libreria di cui a inizio routine, applicahiamo il metodo "Getfolder" all'oggetto "oFSY"
  'Guida Microsoft per dettagli: ht t p: // m s d n . m i c r o s o ft.com/en- u s / l i b r ary/off i c e/gg278492.aspx
  Set oFOL = oFSY.GetFolder(strPath)
   
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  '- per ogni file all'interno della directory, lo apre, va al primo foglio e copia tutti i dati (un solo foglio per ogni file) '
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  For Each oFIL In oFOL.Files 'per ogni file
    
    'troviamo la prima riga libera di colonna "B" del foglio dove andremo ad incollare i dati
    'questo perchè in colonna A dobbiamo scrivere il nome del file
    x = wsTo.Range("B" & wsTo.Rows.Count).End(xlUp).Row + 1
    
    'istanziamo l'oggetto workbook sul file da cui vogliamo copiare
    Set wbFrom = Application.Workbooks.Open(oFIL)
    
    'idem per il foglio da cui copiare, arbitrariamente il primo (1)
    Set wsFrom = wbFrom.Sheets(1)
    
      With wsFrom
      
        'troviamo ultima riga di colonna A, supponendo di dover copiare da lì in mancanza di maggiori informazioni
        i = .Range("B" & .Rows.Count).End(xlUp).Row
        
        'stabiliamo che range copiare, sempre arbitrariamente da seconda riga a colonna Q in mancanza di maggiori dettagli
        Set rngCopy = .Range("A2:Q" & i)
        
        'copiamo il range
        rngCopy.Copy 'wsTo.Cells(x, 2)
        
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' incolla i dati in un nuovo file/foglio che si chiama MAIN     '
        ''hai detto dati duindi procediamo con copia e incolla speciale '
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        wsTo.Cells(x, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
        
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'nella prima colonna del foglio MAIN, inserisca il nome '
        'del file su ogni cella della prima colonna a seconda   '
        'del file da cui i dati sono stati copiati              '
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        wsTo.Range("A" & x & ":A" & x + rngCopy.Rows.Count - 1) = wbFrom.Name
        'qui il "-1" è perchè copiamo da riga 2 occhio!
        
        'distruggiamo oggetto range
        Set rngCopy = Nothing
      End With
    
    
    
    'chiudiamo senza salvare il file aperto
    wbFrom.Close 0
    
    'distruggiamo gli oggetti istanziati poco sopra
    Set wbFrom = Nothing
    Set wsFrom = Nothing
    
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'ripeta la stessa operazione per tutti i files presenti nella directory '
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Next oFIL

Uscita:
  Set oFSY = Nothing
  Set oFOL = Nothing
  Set wbTo = ThisWorkbook
  Set wsTo = Nothing
  Application.DisplayAlerts = False
End Sub