Domanda:

La mia necessità è quella di copiare da file chiusi xls sempre le stesse celle (a4:u200), che si trovano in una cartella in “c:/dati” e incollarli,nel file attivo in quel momento chiamato archivio, sulla prima riga libera partendo dalla colonna A in sequenza, senza lasciare righe libere.

Risposta:

Ho trattato l’argomento nell’articolo “Estrarre dati da cartelle e files chiusi” a cui rimando per la spiegazione di gran parte del codice.
Il link è il seguente: http://www.office-guru.com/wordpress/2013/10/estrarre-dati-da-cartelle-e-files-chiusi/

La necessità del lettore è un pò diversa ed ho apportato quindi alcune modifiche.
Il codice è applicabile ai casi in cui in un’azienda vengano salvati in rete dei report automatici (sempre identici a se stessi)
e si abbia la necessità di riunirli automaticamente in un unico file.

Un punto di attenzione è quello di evitare di importare in arcihivio file già importati.
Questo, oltre ad inficiare sulla correttezza dell’archio, allunga i tempi di esecuzione della macro.
Nel caso d’esempio, nella cartella dati sono presenti solo 3 file ma pensiamo a casi di report giornalieri, con 365 file per anno…

La macro verifica se il file è stato già archiviato e solo in caso negativo provvedere ad aprirlo e copiarne i dati.
Vediamo come si fa.

Con il seguente codice ciclo per tutti i file contenuti nella cartella da analizzare
e riporto nel foglio “Pannello di controllo” nome, percorso, data di creazione, data di ultima modifica e di ultimo accesso al file.

Dim fs, f, f1, s, sf
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(Percorso)
Set sf = f.Files

For Each f1 In sf

Sheet1.Cells(r, 1) = f1.Name
Sheet1.Cells(r, 2) = f1.Path
Sheet1.Cells(r, 3) = f1.DateCreated
Sheet1.Cells(r, 4) = f1.DateLastAccessed
Sheet1.Cells(r, 5) = f1.DateLastModified

next

Fatto ciò inizializzo a zero la varibile “GiaCaricato”
Per ogni file trovato, verifico che il suo nome non sia già presente nel foglio “ARCHIVIO”.
In caso affermativo, non appena il ciclo trova una riga contenente il nome del file,
valorizza ad “1” la variabile “GiaCaricato”, inserisce nel foglio “Pannello do controllo” la nota “Già importato” (Sheet1.Cells(r, 7) = “Già importato”)
ed esce dal ciclo di controllo con l’istruzione “Exit For”

Sheet3.Select
Last_Row = Sheet3.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

GiaCaricato = 0

For Z = 2 To Last_Row

If Sheet3.Cells(Z, 22) = f1.Name Then
   Sheet1.Cells(r, 7) = "Già importato"
   GiaCaricato = GiaCaricato + 1
   Exit For
End If

Next Z

Se invece il nome non è già presente (GiaCaricato = 0) allora procedo a:

–       aprire il file                            ( Workbooks.Open (f1.Path) )
–       copiare il range “A4:U200”     (ActiveWorkbook.Sheets(“Sheet1”).Range(“A4:U200”).Select )
–       individuare l’ultima riga non vuota del foglio “ARCHIVIO”
( Last_Row = Sheet3.Cells.Find(“*”, SearchOrder:=xlByRows,  SearchDirection:=xlPrevious).Row )
–       selezionare la riga successive a l’ultima non vuota (Cells(Last_Row + 1, 1).Select )
–       incollare il range copiato          ( ActiveSheet.Paste)
–       individuare l’ultima riga non vuota del foglio “ARCHIVIO” dopo aver incollato i dati
( Last_Row_AfterPaste = Sheet3.Cells.Find(“*”, SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row )

–       scrivere nelle righe comprese tra Last_Row e Last_Row_AfterPaste nome del file e data creazione
( Sheet3.Range(Cells(Last_Row + 1, 22), Cells(Last_Row_AfterPaste, 22)) = f1.Name )
( Sheet3.Range(Cells(Last_Row + 1, 23), Cells(Last_Row_AfterPaste, 23)) = f1.DateCreated )
–       inserire nel foglio “Pannello do controllo” la nota “IMPORTATO”

If GiaCaricato = 0 Then
   Sheet1.Cells(r, 7) = "IMPORTATO"
   Workbooks.Open (f1.Path)
   ActiveWorkbook.Sheets("Sheet1").Range("A4:U200").Select 'modificare qui per indicare un range diverso da copiare

   Selection.Copy
   Windows(Archivio).Activate
   Sheet3.Select

   Last_Row = Sheet3.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   Cells(Last_Row + 1, 1).Select
   ActiveSheet.Paste

   Last_Row_AfterPaste = Sheet3.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   Sheet3.Range(Cells(Last_Row + 1, 22), Cells(Last_Row_AfterPaste, 22)) = f1.Name
   Sheet3.Range(Cells(Last_Row + 1, 23), Cells(Last_Row_AfterPaste, 23)) = f1.DateCreated

   Windows(f1.Name).Close

End If

A voi il file:
APRI

Riccardo Vincenti

The following two tabs change content below.

• Bio
• Ultimi Post

Riccardo Vincenti

Ultimi post di Riccardo Vincenti (vedi tutti)

• 073. Duplicare righe excel modificando il contenuto - 6 Ottobre 2017
• 072. Estrazione numeri casuali - 6 Ottobre 2017
• 071. Estrazione casuale valori da un elenco - 5 Ottobre 2017
• 070. Contare dati univoci senza Pivot - 21 Settembre 2017
• 069. Aggiungere intervalli ad una data: Date Add in Excel - 21 Settembre 2017

This work by Riccardo Vincenti is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International