Attribute VB_Name = "Modulo_AccodaTuttiFogli"
' Il nome del corrente modulo VBA (Visual Basic for Application)
' deve iniziare con i caratteri "Modulo" ed avere estensione ".bas".
' Per importarlo dentro un Excel 2007 ".xlsm" (con macro attivate), esegui
'    Sviluppo, Visual Basic, File, Importa file...
' e, infine, scegli il file corrente dalla finestra di importazione.

Sub AccodaTuttiFogli()
Attribute AccodaTuttiFogli.VB_ProcData.VB_Invoke_Func = " \n14"

'La presente Subroutine accoda in un unico foglio il contenuto di tutti i fogli di tutte le cartelle excel (*.xls*)
'presenti nello stesso indirizzario di residenza.
'Essendo nata sopra cartelle con collegamenti da non rinfrescare, se ne preoccupa evitando
'di costringere l'utente a rispondere ai messaggi di richiesta.

Dim FoglioRicevente As Worksheet
Dim NomeFoglio As String
Dim IndirizzarioDatore As String
Dim CartellaRicevente As String
Dim CartellaDatrice As String
Dim CartellaDatriceQualificata As String
Dim CartellaDatriceGenerica As String
Dim Foglio As Worksheet

Dim UltimaRigaRicevente As Long
Dim UltimaRigaDatrice As Long

On Error GoTo RigaErrore

' --> Digita qui il nome generico delle cartelle datrici da ammucchiare nel foglio ricevente.
CartellaDatriceGenerica = "*.xls*"

'Annota l'indirizzario del file corrente che contiene anche le cartelle datrici da ammucchiare nel foglio ricevente.
IndirizzarioDatore = ActiveWorkbook.Path

'Annota il nome della cartella ricevente.
CartellaRicevente = ActiveWorkbook.Name

'Annota il nome del foglio ricevente.
Set FoglioRicevente = Worksheets(ActiveSheet.Name)

'Non aggiorna il video per non rallentare l'elaborazione.
Application.ScreenUpdating = True
  
'Elenca i file Excel da ammucchiare nel foglio ricevente.
CartellaDatrice = Dir(IndirizzarioDatore & "\" & CartellaDatriceGenerica)

'Pulisce il foglio ricevente
FoglioRicevente.Rows("2:" & Rows.Count).Delete

'Esegue su tutti i file Excel elencati.
Do While Len(CartellaDatrice) > 0
    'Se la cartella datrice corrente non č la ricevente.
    If CartellaDatrice <> CartellaRicevente Then
        'Elabora il singolo file Excel.
  
        'Compone il nome qualificato del file Excel datore.
        CartellaDatriceQualificata = IndirizzarioDatore & "\" & CartellaDatrice
        
        'Disinnesca messaggi.
        Application.DisplayAlerts = False
        'Apre il file Excel datore.
        '(In Office2007 UpdateLinks:=xlUpdateLinksNever pare non funzionare. Perciņ disinnesca i messaggi.)
        Workbooks.Open Filename:=CartellaDatriceQualificata, UpdateLinks:=xlUpdateLinksNever
        'Reinnesca messaggi.
        Application.DisplayAlerts = True
        
        'Per ogni foglio della cartella
        For Each Foglio In ActiveWorkbook.Worksheets
            
            'Annota foglio datore.
            NomeFoglio = Foglio.Name
            'Attiva la cartella datrice.
            Windows(CartellaDatrice).Activate
            'Sceglie il foglio datore.
            Worksheets(NomeFoglio).Select
            'Annota l'ultima riga del foglio datore.
            UltimaRigaDatrice = Worksheets(NomeFoglio).Range("A" & Rows.Count).End(xlUp).Row
            'Copia le righe dal foglio datore.
            Worksheets(NomeFoglio).Rows("1:" & (UltimaRigaDatrice + 1)).Select
            Selection.Copy
            
            'Attiva la cartella ricevente.
            Windows(CartellaRicevente).Activate
            'Sceglie il foglio ricevente.
            FoglioRicevente.Select
            'Annota l'ultima riga piena del foglio ricevente.
            UltimaRigaRicevente = FoglioRicevente.Range("A" & Rows.Count).End(xlUp).Row
            'Si posiziona all'inizio della prima riga libera nel ricevente.
            FoglioRicevente.Range("A" & UltimaRigaRicevente + 1).Select
            'Disinnesca messaggi.
            Application.DisplayAlerts = False
            'Incolla le righe del datore in coda al ricevente.
            Selection.PasteSpecial Operation:=xlNone, SkipBlanks:=False, Transpose:=False
           'Reinnesca messaggi.
            Application.DisplayAlerts = True
            
        'Per ogni foglio della cartella
        Next
        
        'Evita il messaggio di richiesta getta appunti.
        Application.CutCopyMode = False
        'Ritorna sulla cartella datrice.
        Windows(CartellaDatrice).Activate
        'Chiude la cartella datrice evitando di aggiornare.
        ActiveWindow.Close SaveChanges:=False
        
    'Se la cartella datrice corrente non č la ricevente.
    End If
    
    'Si posizionava ad inizio ricevente per ragioni di debug.
    'Range("A1").Select
    
    'Estrae il prossimo nome del file datore.
    CartellaDatrice = Dir()
    
'Esegue su tutti i file Excel elencati.
Loop

'Ritorna sulla cartella ricevente.
Windows(CartellaRicevente).Activate
'Focalizza il foglio ricevente.
Sheets(FoglioRicevente.Name).Activate
'Riporta la selezione alla prima casella.
FoglioRicevente.Range("A1").Select

'GESTIONE CHIUSURA ED ERRORI.
RigaChiusura:

With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

Exit Sub

RigaErrore:

MsgBox Err.Number & vbNewLine & Err.Description
Resume RigaChiusura

End Sub