[Tutorial VBA] Lavorare con due (o più) files

Stato
Chiusa ad ulteriori risposte.

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
19.676
133
Como
2011MAC 2016WIN
400
Ciao a tutti,
vedo spesso richieste di utenti che vogliono copiare dati da altri file Excel oppure vogliono traferire su altri file dei dati che hanno nel file aperto o ancora vogliono cercare dei dati tra altri file.

A tale proposito ho pensato di creare una mini guida esemplificativa con alcuni passaggi che comunque sono sempre comuni quando si tratta di interagire con altri file.

Prendiamo in esame, per esempio, il caso che vogliamo prelevare da un altro file.

Chiamo l'altro file con il quale devo interagire "FileAltro".

Dichiaro le variabili

I due files (cioè le due cartelle Excel)
Codice:
Dim WK1 As Workbook
Dim WK2 As Workbook
I fogli con i quali voglio interagire
Codice:
Dim sh1 As Worksheet
Dim sh2 As Worksheet
L’atro file
Codice:
Dim FileAltro As String
Poniamo la condizione che l'altro file è chiuso.
A questo punto abbiamo varie possibilità per trovare l'altro file sul computer ed aprirlo: indicare il percorso oppure trovare il percorso tramite finestra di dialogo.

La prima scelta ci porta a scrivere il percorso esatto.
Per esempio, mettiamo che il file si chiama "esempio" ed è posizionato sul Desktop:
Codice:
Set WK2 = Workbooks.Open("C:\Users\Ges\Desktop\esempio.xlsx")
Può essere che l'altro file stia nella stessa directory del nostro file aperto (per esempio, stessa cartella), a questo punto potremo usare questa istruzione:
Codice:
Set WK1 = ThisWorkbook
Set WK2 = Workbooks.Open(WK1.Path & "\" & " esempio.xlsx ")
L'altra ipotesi è che vogliamo cercarlo noi usando la finestra di dialogo
Codice:
FileAltro = Application.GetOpenFilename
Potremmo scegliere di visualizzare solo i files Excel
Codice:
FileAltro = Application.GetOpenFilename("File Excel (*.xls), *.xls")
Impostiamo come riferimento alle variabile sh1 e sh2 i due fogli rispettivamente del nostro file e dell'atro file (mettiamo che si chiamino tutte e due "Foglio1").
Codice:
Set WK1 = ThisWorkbook
Set WK2 = Workbooks.Open(FileAltro)
         
Set sh1 = WK1.Worksheets("Foglio1")
Set sh2 = WK2.Worksheets("Foglio1")
A questo punto i due file sono aperti e le variabili assegnate possiamo fare quindi quello che vogliamo.

Esempio:

Copiare dal filealtro:
Codice:
sh2.Range("A1:D10").Copy
sh1.Range("A1").PasteSpecial Paste:=xlValues
Trasferire dei dati
Codice:
sh2.Range("A1") = sh1.Range("A1")
Ciclare un intervallo:
Codice:
  x = 1
            For i = 1 To 10
                If sh2.Range("A" & i) = "topolino" Then
                    sh1.Range("A" & x) = sh2.Range("A" & i)
                    x = x + 1
                End If
            Next i
ecc. ecc.

Finito il nostro lavoro possiamo salvare e chiudere il "FileAltro".
Codice:
WK2.Save
WK2.Close
Nel caso aprendo la finestra di dialogo c'è un "pentimento", cioè si vuole annullare la procedura, per evitare che il codice restante venga eseguito si può usare questa istruzione

Codice:
If FileAltro = "Falso" Then
            MsgBox "Operazione annullata!", vbOKOnly + vbInformation
            GoTo Chiudi
End If
Questo il codice completo che copia dal "FileAltro".
Codice:
Sub Copia_da_FileAltro()
    Dim WK1 As Workbook
    Dim WK2 As Workbook
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim FileAltro As String
    Application.ScreenUpdating = False
         
    FileAltro = Application.GetOpenFilename
    If FileAltro = "Falso" Then
        MsgBox "Operazione annullata!", vbOKOnly + vbInformation
        GoTo Chiudi
    End If
         
    Set WK1 = ThisWorkbook
    Set WK2 = Workbooks.Open(FileAltro)
         
    Set sh1 = WK1.Worksheets("Foglio1")
    Set sh2 = WK2.Worksheets("Foglio1")
         
    sh2.Range("A1:D10").Copy
    sh1.Range("A1").PasteSpecial Paste:=xlValues

    Application.CutCopyMode = False
    WK2.Save
    WK2.Close
    Application.ScreenUpdating = True
Chiudi:
    Set sh2 = Nothing
    Set sh1 = Nothing
    Set WK1 = Nothing
    Set WK2 = Nothing
End Sub
Spero di essere stato chiaro e che questa mini guida possa essere utile a chi ha bisogno di interagire tra due o più files.

Se ho omesso qualcosa o fatto qualche errore ognuno è libero di segnalarlo ed eventualmente integrare.
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
19.676
133
Como
2011MAC 2016WIN
400
INTERAGIRE CON PIU' FILES CONTENUTI IN UNA CARTELLA

Continuando la discussione su che riguarda l'interazione tra due o più files, vorrei considerare anche la condizione in cui due o più files sono nella stessa cartella e c'è bisogno di interagire con tutti questi files.

In base al codice postato sopra si dovrebbe interagire più volte con ogni singolo file, allora facendo una piccola modifica e integrazione è possibile con una sola macro agire con tutti i file trattandoli uno alla volta.

Il primo passo è indicare il percorso della cartella con i file interessati, in questo esempio utilizzo la proprietà Application.FileDialog(msoFileDialogFolderPicker)

Tale proprietà apre la finestra di dialogo per permette di scegliere una cartella.

Prima di aprire la finestra di dialogo tramite il metodo Show predispongo un messaggio (MsgBox) con cui chiedo di scegliere la cartella con i files.

La cartella viene scelta con un ciclo in In .SelectedItems

Codice:
Dim miaCartella
Dim fd As FileDialog
Dim fDialog As FileDialog

Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
   
    MsgBox "Scegli la cartella con i files!", vbInformation, "AVVISO"
   
  With fDialog        
    .Show
    cartella = .SelectedItems(1)
Selezionata la cartella si dichiara il file dal quale si sta operando e il foglio interessato

Codice:
 Set WK = ThisWorkbook
 Set sh = WK.Worksheets(1)
Utilizzo CreateObject("Scripting.FileSystemObject")

Codice:
 Set fs = CreateObject("Scripting.FileSystemObject")
che per una migliore spiegazione vi rimando al sito Ennius.altervista

Richiamo la cartella selezionata

Codice:
Set Fold = fs.getfolder(cartella)
Set Cartella = Fold.Files
E con un ciclo esamino tutti i files contenuti e il foglio (o i fogli)

Codice:
 For Each Nomefile In Cartella
        Set WK1 = Workbooks.Open(Nomefile)
        Set sh1 = WK1.Worksheets(1)
A questo punto sono "in contatto" con ciascun file e il foglio (o i fogli) contenuti nella cartella e posso fare quello che voglio (copiare, modificare, cancellare, ecc.)

Alla fine salvo e chiudo

Codice:
WK1.Save
WK1.Close
Come esempio posto un codice che copia tutti i dati di ciascun file contenuto nel Foglio1 della cartella e li incolla uno sotto l'altro nel file dal quale opero.

Codice:
Sub Copia_piu_file_da_cartella()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim fDialog As FileDialog
    Dim i As Integer
    Dim uR As Long
    Dim uR1 As Long
    Dim WK As Workbook
    Dim WK1 As Workbook
    Dim sh As Worksheet
    Dim sh1 As Worksheet
    Dim fs As Object
    Dim Fold As Object
    Dim Nomefile As Object
    Dim cartella As Variant
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
        MsgBox "Scegli la cartella con i files!", vbInformation, "AVVISO"
    With fDialog
         .Show
    cartella = .SelectedItems(1)
End With
    Set WK = ThisWorkbook
    Set sh = WK.Worksheets(1)
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set Fold = fs.getfolder(cartella)
    Set cartella = Fold.Files
    For Each Nomefile In cartella
        Set WK1 = Workbooks.Open(Nomefile)
        Set sh1 = WK1.Worksheets(1)
        uR = sh1.Cells(Rows.Count, 1).End(xlUp).Row
        sh1.Range("A1:L" & uR).Copy
        DoEvents
        uR1 = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
        sh.Range("A" & uR1).PasteSpecial Paste:=xlValues
        WK1.Save
        WK1.Close
    Next
    WK.Save
    MsgBox "Fatto!", vbInformation, "NOTIFICA"
    Set fs = Nothing
    Set cartella = Nothing
    Set Fold = Nothing
    Set fDialog = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Exit Sub
esci:
    MsgBox "Si è verificato un errore, forse non hai digitato correttamente la cella scelta." & vbCrLf & "Ripeti l'operazione!", vbExclamation, "ATTENZIONE"
    WK.Save
End Sub
Se ho tralasciato o fatto qualche errore, ciascuno può integrare.
 
Ultima modifica:
Stato
Chiusa ad ulteriori risposte.

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!