[Excel VBA] Importazione WorkSheets da files esterni

Descrizione :
Una tecnica per automatizzare l'importazione su singolo file Excel di fogli da files esterni e da varie cartelle.

+ Articolo :

E' necessario predisporre un WorkBook di "comando", che esegue il codice necessario per la creazione di un nuovo WorkBook di "destinazione", che conterrà, alla fine del processo, N Fogli presi da N Files esterni che si trovano in percorsi forniti come array di percorsi alla routine del comando stesso.
Per semplicità, nell'esempio seguente viene mostrato come importare il primo Foglio di ciascuno dei files Excel trovati, in ciascuna delle directory inserite nell'array.

Il File "Comando.xls" ha un solo Foglio "Foglio1" con un CommandButton.

All'esecuzione il File Comando copia in se stesso tutti i Fogli di un certo indice ( nel nostro caso il Foglio a indice 1 ) trovati nei Files contenuti in tutti i percorsi di ricerca forniti. Alla fine del processo il file Comando salva se stesso con un nome predefinito per il File di Output ed elimina il Foglio che contiene la routine di creazione.
In questo modo evito di gestire la creazione di un terzo file e l'inserimento dei Fogli sullo stesso, che aggiungerebbe all'operazione una serie di passaggi inutili, inoltre il salvataggio permette di chiudere automaticamente il file Comando senza rischi di sovrascrittura...

N.B.: Aggiungere un Rif. alla libreria "Microsoft Scripting Runtime".

--> Codice per il pulsante su Comando.xls :

    'Aggiungere RIF.: Microsoft Scripting Runtime
 
    Dim FSO As New Scripting.FileSystemObject
 
    Dim percorsi() As Variant
    percorsi = Array(ThisWorkbook.Path & "\Cartella1\", ThisWorkbook.Path & "\Cartella2\")
    Dim percorsoDest As String
    percorsoDest = ThisWorkbook.Path & "\"
 
    Dim nomeFileDest As String
    nomeFileDest = "Destinazione.xls"
    If FSO.FileExists(percorsoDest & nomeFileDest) = True Then
        FSO.DeleteFile percorsoDest & nomeFileDest
    End If
 
    Dim fd As Folder
    Dim f As File
    Dim nomeFile As String
    Dim nomeFoglio As String
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim cnt As Integer
    cnt = 1
 
    Application.ScreenUpdating = False
    'Application.Visible = False
 
    For Each percorso In percorsi
        Set fd = FSO.GetFolder(percorso)
        For Each f In fd.Files
            'Controllo sulle estensioni dei file da importare...
            If FSO.GetExtensionName(f.Path) = "xls" Then ' OR < altre estensioni Excel >...
                nomeFile = f.Name
                nomeFoglio = cnt & "_" & Left(nomeFile, Len(nomeFile) - Len(FSO.GetExtensionName(f.Path)) - 1)
 
                Set WB = Application.Workbooks.Open(percorso & nomeFile)
                Set WS = WB.Worksheets(1)
                WS.Name = nomeFoglio
                WS.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
 
                WB.Close False
                Set WB = Nothing
                cnt = cnt + 1
            End If
        Next f
    Next percorso
 
    Application.ScreenUpdating = True
    'Application.Visible = True
 
    ThisWorkbook.SaveAs percorsoDest & nomeFileDest
    MsgBox "Fogli Importati.", vbInformation, "OK"
 
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets(1).Delete

Alcune note :

1. Come spesso accade, gran parte dell'apparente laboriosità nell'esecuzione di un codice VBA dipende principalmente da questioni di refresh grafico. Allo scopo di rendere più snello il processo è presente una riga con Application.ScreenUpdating = False.
Ho volutamente lasciato anche Application.Visible = False, commentato, da usarsi in alternativa al primo, con l'effetto di rendere l'esecuzione ancora più veloce.
Unico inconveniente è che su importazioni lunghe l'utente vedrebbe sparire la finestra di Excel per un certo tempo e potrebbe iniziare... a preoccuparsi, perciò fate vobis.

2. E' possibile inserire altre estensioni ( senza il punto ) sulla riga di controllo delle estensioni da prendere in esame, mettendole in OR tra loro :

'Controllo sulle estensioni dei file da importare...
If FSO.GetExtensionName(f.Path) = "xls" Then ' OR < altre estensioni Excel >...

3. Il processo nomina in automatico ogni nuovo foglio importato con un numero progressivo + il nome del file di origine. Ogni modifica al metodo con cui nominare i Fogli va fatto qui :

...
nomeFoglio = cnt & "_" & Left(nomeFile, Len(nomeFile) - Len(FSO.GetExtensionName(f.Path)) - 1)

4. La riga di eliminazione del Foglio codice, se desiderata, deve sempre essere l'ultima ad essere eseguita :

...
...
ThisWorkbook.Worksheets(1).Delete
 
End Sub

+ Fine Articolo.

---

Un Click su "Mi Piace" è il modo migliore per ringraziare l'autore di questo articolo.

---

Posted in: Excel VBA