Attribute VB_Name = "Modulo_AccodaFogli"
' 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 AccodaFogli()

'La presente Subroutine copia come fogli propri i primi fogli di tutte le cartelle excel (*.xls*)
'presenti nello stesso indirizzario di residenza.
'Essendo nata sopra cartelle con collegamenti rinfrescabili, se ne preoccupa evitando
'di costringere l'utente a rispondere ai messaggi di richiesta.

Dim IndirizzarioDatore As String
Dim CartellaDatrice As String
Dim CartellaDatriceQualificata As String
Dim CartellaDatriceGenerica As String
Dim FoglioRicevente 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 del foglio ricevente.
Set FoglioRicevente = Worksheets(ActiveSheet.Name)
'Annota il nome della cartella ricevente.
CartellaRicevente = ActiveWorkbook.Name

'Non aggiorna il video per non rallentare l'elaborazione.
Application.ScreenUpdating = False
  
'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 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
        
        'Apre il file Excel datore.
        'Visto che in Office2007 UpdateLinks:=xlUpdateLinksNever pare non funzionare,
        'prima dell'esecuzione disinnesca la messaggistica, poi la reinserisce.
        Application.DisplayAlerts = False
        Workbooks.Open Filename:=CartellaDatriceQualificata, UpdateLinks:=xlUpdateLinksNever
        Application.DisplayAlerts = True
    
        'Annota cartella e foglio datori.
        NomeCartella = ActiveWorkbook.Name
        NomeFoglio = ActiveSheet.Name
        'Annota l'ultima riga del foglio datore.
        UltimaRigaDatrice = Worksheets(NomeFoglio).Range("A" & Rows.Count).End(xlUp).Row
        'Annota l'ultima riga del foglio ricevente.
        UltimaRigaRicevente = FoglioRicevente.Range("A" & Rows.Count).End(xlUp).Row
        
        'Copia le righe del foglio datore.
        Worksheets(NomeFoglio).Select
        Worksheets(NomeFoglio).Rows("1:" & (UltimaRigaDatrice + 1)).Select
        Selection.Copy
        
        'Incolla le righe del datore in coda al ricevente.
        Windows(CartellaRicevente).Activate
        FoglioRicevente.Select
        FoglioRicevente.Range("A" & UltimaRigaRicevente + 1).Select
        Application.DisplayAlerts = False
        Selection.PasteSpecial Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.DisplayAlerts = True
        
        'Evita il messaggio di richiesta getta appunti.
        Application.CutCopyMode = False
        
        'Chiude il datore.
        Windows(NomeCartella).Close
    
    'Se la datrice corrente non è la ricevente.
    End If
    
    'Estrae il prossimo nome del file datore.
    CartellaDatrice = Dir()
    
'Esegue su tutti i file Excel elencati.
Loop

'Riporta la selezione alla prima casella.
FoglioRicevente.Range("A1").Select

RigaChiusura:

With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With
Set FoglioRicevente = Nothing
Exit Sub

RigaErrore:

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

End Sub