Attribute VB_Name = "Modulo_AccodaCellulare"
' 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 AccodaCellulare()
Attribute AccodaCellulare.VB_ProcData.VB_Invoke_Func = " \n14"

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 = "*traffico*.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
    'Elabora il singolo file Excel.
  
    'Compone il nome qualificato del file Excel datore.
    CartellaDatriceQualificata = IndirizzarioDatore & "\" & CartellaDatrice
    'Apre il file Excel datore.
    Workbooks.Open Filename:=CartellaDatriceQualificata
    '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
    Selection.PasteSpecial Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    'Evita il messaggio di richiesta getta appunti.
    Application.CutCopyMode = False
    
    'Chiude il datore.
    Windows(NomeCartella).Close
    
    '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