Condividi:        

[EXCEL 2010] Unione di più files excel in un unico file

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

[EXCEL 2010] Unione di più files excel in un unico file

Postdi Alededio » 22/05/15 16:08

Ciao a tutti,

vorrei chiedere il vostro aiuto per finire un lavoro che sto facendo.
Sono arrivato al punto in cui devo mettere insieme tutti i dati raccolti in diversi files excel (tutti con stessa formattazione). Questi dati si trovano nella Tabella1 del Foglio1 di ogni file.

Dovrei creare un file in cui nella Tabella1 del Foglio1 vengano inseriti tutti i dati dei diversi files, in modo tale da poter poi elaborare i dati raccolti attraverso tabelle pivot.

E' importante sottolineare che la raccolta dati continuerà in futuro, quindi avrò sempre nuovi dati da aggiungere al file.

Per ora con la seguente macro (postata tempo fa da Flash), ho fatto in modo che il file copiasse nel Foglio1 tutti i dati contenuti negli altri file contenuti nella stessa cartella. Una volta copiati i dati, automaticamente i files vengono spostati in una cartella "ArchivioInseriti".

Codice: Seleziona tutto
    Public perc As String, Ws1 As String, f As String, WB1 As String
    Sub GiovaniXls()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    perc = ThisWorkbook.Path
    If Dir(perc & "\ArchivioInseriti", vbDirectory) = "" Then
        MkDir (perc & "\ArchivioInseriti")
    End If
    WB1 = ThisWorkbook.Name
    Ws1 = "GIOVANI"
    Worksheets(Ws1).Select
    Range("A1").Select
      Giovani Direct:=perc, Estens:="*.xls*", Inicell:=ActiveCell
                Range("A1").Select
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    End Sub
    Sub Giovani(Direct As String, Estens As String, Inicell As Range)
      Dim i As Integer, f As String
      ChDir Direct
      f = Dir(Estens)
      If f = "" Then Exit Sub
      While f <> ""
        If f <> ThisWorkbook.Name Then
            Application.Workbooks.Open perc & "\" & f
            URF = Workbooks(f).Worksheets("GIOVANI").Range("A" & Rows.Count).End(xlUp).Row
            URR = Workbooks(WB1).Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row
            Workbooks(f).ActiveSheet.Rows("2:" & URF).Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1)
            Workbooks(f).Close savechanges:=False
            FileCopy perc & "\" & f, perc & "\ArchivioInseriti\" & f
                Kill perc & "\" & f
        End If
        f = Dir
      Wend
    End Sub


Tuttavia, il range che viene copiato non è limitato alla tabella1, ma viene copiato l'intero foglio1.

Se possibile, vorrei anche inserire da qualche parte i nomi dei files copiati, così da poter effettuare dei controlli.

Spero che qualcuno possa aiutarmi.

Grazie mille a tutti in anticipo!
Alededio
Newbie
 
Post: 7
Iscritto il: 21/05/15 23:13

Sponsor
 

Re: [EXCEL 2010] Unione di più files excel in un unico file

Postdi Anthony47 » 23/05/15 01:43

Ciao Alededio, benvenuto nel forum.
Se il file da copiare contiene un struttura tabella e vuoi copiare solo quella, allora dovrai sostituire la riga
Workbooks(f).ActiveSheet.Rows("1:" & URF).Copy
Con
Codice: Seleziona tutto
Workbooks(f).ActiveSheet.ListObjects(1).DataBodyRange. Copy


Se la struttura invece non e' stata dichiarata "Tabella" allora avrai un run time error sulla nuova istruzione; in questo caso dovresti indicare l' area che hai riservato alla tabella e vedremo come limitare la copia a quell' intervallo.

Vorrei sapere se l' altro quesito che hai pubblicato (vedi viewtopic.php?f=26&t=103754&start=20#p610986) e' un duplicato di questo o e' una cosa a se stante.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL 2010] Unione di più files excel in un unico file

Postdi Alededio » 23/05/15 13:25

Ciao Anthony, grazie mille!!
Ora funziona nel modo che cercavo.
Ora sto cercando di far scrivere il nome del file copiato, in un'altra tabella, Tabella2 Foglio1del file totale.
Hai qualche suggerimento? Scusa se ne approfitto, ma con le macro vado molto a tentativi :) .

Per quanto riguarda il quesito pubblicato nell'altro topic, è lo stesso per cui ho aperto questo nuovo topic.

Ciao
Alededio
Newbie
 
Post: 7
Iscritto il: 21/05/15 23:13

Re: [EXCEL 2010] Unione di più files excel in un unico file

Postdi Alededio » 23/05/15 17:18

Ciao Anthony,

1) Ho notato che:
- se la Tabella1 del file di riepilogo ha una sola riga sotto l'intestazione, i dati del PRIMO file copiato (e di coseguenza tutti gli altri) vengono copiati al di fuori della tabella (la tabella non di ridimensiona includendoli).
- se la Tabella1 del file di riepilogo ha almeno due righe sotto l'intestazione, i dati vengono copiati dentro alla tabella (la tabella si ridimensiona includendo i dati).

Sai da cosa può dipendere? Io penso che sia perchè il primo file viene copiato lasciando una riga libera prima.

2) Ho provato ad inserire:
Codice: Seleziona tutto
 Workbooks(WB1).Worksheets(Ws1).Range("S:S") = Workbooks(f).name

Ma copiava il nome del file su tutta la colonna S, ho quindi corretto il codice come segue:

Codice: Seleziona tutto
Sub Giovani(Direct As String, Estens As String, Inicell As Range)
      Dim i As Integer, f As String
      ChDir Direct
      f = Dir(Estens)
      If f = "" Then Exit Sub
      While f <> ""
        If f <> ThisWorkbook.Name Then
            Application.Workbooks.Open perc & "\" & f
            URF = Workbooks(f).Worksheets("GIOVANI").Range("A" & Rows.Count).End(xlUp).Row
            URR = Workbooks(WB1).Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row
            UR = Workbooks(WB1).Worksheets(Ws1).Range("S" & Rows.Count).End(xlUp).Row   'nuovo contatore
            Workbooks(f).ActiveSheet.ListObjects(1).DataBodyRange.Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1)
            Workbooks(WB1).Worksheets(Ws1).Range("S" & UR + 1) = Workbooks(f).Name   'comando per copiare il nome file nella colonna S
            Workbooks(f).Close savechanges:=False
            FileCopy perc & "\" & f, perc & "\ArchivioInseriti\" & f
                Kill perc & "\" & f
        End If
        f = Dir
      Wend
    End Sub


Provandolo funziona, ma credi sia un modo corretto?

Grazie!
Alededio
Newbie
 
Post: 7
Iscritto il: 21/05/15 23:13

Re: [EXCEL 2010] Unione di più files excel in un unico file

Postdi Anthony47 » 23/05/15 18:50

Ma non ti conviene scrivere il nome file in colonna S ma accanto alle righe importate da quel file?

Come pure, invece di Workbooks(f).Name ti bastera' usare "f".

Infine invece di copiare + killare ti converra' spostare.

Quindi invece di
Workbooks(WB1).Worksheets(Ws1).Range("S" & UR + 1) = Workbooks(f).Name 'comando per copiare il nome file nella colonna S
Workbooks(f).Close savechanges:=False
FileCopy perc & "\" & f, perc & "\ArchivioInseriti\" & f
Kill perc & "\" & f

potresti usare
Codice: Seleziona tutto
            Workbooks(WB1).Worksheets(Ws1).Range("S" & URR + 1).Resize(ActiveSheet.ListObjects(1).DataBodyRange.Rows.Count, 1) = f   'nome file
            Workbooks(f).Close savechanges:=False
            Name (perc & "\" & f) As (perc & "\ArchivioInseriti\" & f)    ' Sposta il file


Puoi anche cancellare la riga UR = Workbooks(WB1).etc.etc

Quanto al fatto che le righe possono essere copiate fuori dalla struttura tabella, vorrei sapere se questa struttura e' stata creata esplicitamente da te nel file destinazione (come dovrebbe essere) o viene creata per buona volonta' di Excel durante la copia.
Comunque, c' e' una colonna da utilizzare come indicatore di fine tabella? Cioe' una colonna che deve essere certamente compilata, quindi la prima vuota rappresenta la fine della tabella. In questo caso si potra' aggiungere esplicitamente un tot di righe alla tabella di destinazione (che deve esistere sul foglio di destinazione) prima di incollare i dati dell' altro file.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL 2010] Unione di più files excel in un unico file

Postdi Alededio » 25/05/15 12:30

Ciao Anthony,

ti posto il link alla cartella, così che tu possa vedere con che tipo di file ho a che fare.

https://www.dropbox.com/sh/myrtyflqyqp8diz/AADeYub1MzlYzvzVCpaOC-K5a?dl=0

Sostituendo il pezzo di codice da te suggerito, mi da errore e la copia dei file viene arrestata.
Mentra se lascio il codice invariato, funziona tutto. Tranne il fatto che salta la prima riga della tabella (nel link che ho condiviso c'è un immagine oltre ai file e dovrebbe essere abbastanza chiaro cosa intendo).

Per quanto riguarda le tabelle, ho formattato tutte le colonne da A a Q come tabella sia nel file di riepilogo, sia nei file da cui poi estrarrò i dati. E vorrei che quella nel file di ripeilogo cambiasse automaticamente la sua dimensione man mano che i file vengono copiati.

La colonna S nel file di riepilogo serve a me come controllo per verificare che i file siano stati copiati.

Grazie mille per la pazienza :)
Alededio
Newbie
 
Post: 7
Iscritto il: 21/05/15 23:13

Re: [EXCEL 2010] Unione di più files excel in un unico file

Postdi Anthony47 » 26/05/15 23:40

Ho scoperto che lavorando con le tabelle il calcolo dell' ultima riga usata deve essere diversa dal solito [tipo End(xlUp)]; infatti il calcolo con End(xlUp) restituisce la prima riga fuori dalla tabella, come se non fosse previsto che in una tabella ci possano essere righe vuote.
Pertanto, per poter inserire i dati prelevati da fogli esterni, ho modificato il calcolo di URR:
non URR = Workbooks(WB1).Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row
ma
URR = Workbooks(WB1).Worksheets(Ws1).ListObjects(1).ListColumns(1).Range.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
(funziona in una tabella con intestazioni).

Applicando questa modifica e le altre suggerite nel messaggio precedente, ho ottenuto questo codice che mi sembra funzionante:
Codice: Seleziona tutto
Sub Giovani(Direct As String, Estens As String, Inicell As Range)
  Dim i As Integer, f As String
  ChDir Direct
  f = Dir(Estens)
  If f = "" Then Exit Sub
  While f <> ""
    If f <> ThisWorkbook.Name Then
        Application.Workbooks.Open perc & "\" & f
        URF = Workbooks(f).Worksheets("GIOVANI").Range("A" & Rows.Count).End(xlUp).Row
        URR = Workbooks(WB1).Worksheets(Ws1).ListObjects(1).ListColumns(1).Range.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
'            URR = Workbooks(WB1).Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row
        UR = Workbooks(WB1).Worksheets(Ws1).Range("S" & Rows.Count).End(xlUp).Row
        Workbooks(f).ActiveSheet.ListObjects(1).DataBodyRange.Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1)
        Workbooks(WB1).Worksheets(Ws1).Range("S" & URR + 1).Resize(Workbooks(f).ActiveSheet.ListObjects(1).DataBodyRange.Rows.Count, 1) = f   'nome file
        Workbooks(f).Close savechanges:=False
        Name (perc & "\" & f) As (perc & "\ArchivioInseriti\" & f)    ' Sposta il file
    End If
    f = Dir
  Wend
End Sub

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL 2010] Unione di più files excel in un unico file

Postdi Alededio » 27/05/15 10:15

Ti ringrazio Anthony! Sei stato davvero gentilissimo! Io purtroppo per ora posso limitarmi a guardare in giro e adattare quello che trovo alle mie necessità, quindi quando le cose si complicano devo ricorrere ad alcuni aiuti :)

Ho dovuto modificare leggermente il codice perchè ho creato un foglio dedicato all'elenco dei file copiati.
Inoltre mi dava un'errore che ho risolto eliminando la parte:


'Resize(Workbooks(WB1).Worksheets("FILE_COPIATI").ListObjects(1).DataBodyRange.Rows.Count, 1) = f 'nome file


quindi il codice che mi restituisce quanto desiderato senza errori (sembrerebbe) è:
Codice: Seleziona tutto
    Sub Giovani(Direct As String, Estens As String, Inicell As Range)
      Dim i As Integer, f As String
      ChDir Direct
      f = Dir(Estens)
      If f = "" Then Exit Sub
      While f <> ""
        If f <> ThisWorkbook.Name Then
            Application.Workbooks.Open perc & "\" & f
            URF = Workbooks(f).Worksheets("GIOVANI").Range("A" & Rows.Count).End(xlUp).Row
            URR = Workbooks(WB1).Worksheets(Ws1).ListObjects(1).ListColumns(1).Range.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
            UR = Workbooks(WB1).Worksheets("FILE_COPIATI").ListObjects(1).ListColumns(1).Range.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row

            Workbooks(f).ActiveSheet.ListObjects(1).DataBodyRange.Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1)
            Workbooks(WB1).Worksheets("FILE_COPIATI").Range("A" & UR + 1) = f
   '         Resize(Workbooks(WB1).Worksheets("FILE_COPIATI").ListObjects(2).DataBodyRange.Rows.Count, 1) = f   nome file
            Workbooks(f).Close savechanges:=False
            Name (perc & "\" & f) As (perc & "\ArchivioInseriti\" & f)    ' Sposta il file
        End If
        f = Dir
      Wend
ThisWorkbook.RefreshAll 'aggiorna tutto il file con tabelle pivot
    End Sub


L'unica cosa è che se qualche allenatore dovesse inviarmi dei file senza rinominarli, se non sbaglio, il programma si blocca perchè nella cartella "ArchivioInseriti" esiste già un file con lo stesso nome.

Sto cercando il modo per rinominare il duplicato come es. GIOVANI(1) e continuare a copiare.

Se hai qualche suggerimento è molto benaccetto!

Grazie ancora!
Alededio
Newbie
 
Post: 7
Iscritto il: 21/05/15 23:13

Re: [EXCEL 2010] Unione di più files excel in un unico file

Postdi Anthony47 » 27/05/15 23:21

Se invece di usare Name torni alle istruzioni originali (FileCopy perc & "\" & f, perc & "\ArchivioInseriti\" & f / Kill perc & "\" & f) allora in caso di file esistente il nuovo sostituira' il precedente senza ulteriori messaggi di errori.
In alternativa modifichi i nomi dei file prima di spostarli, aggiungendo una parte randomica prima del nome file (es 05523_PROVA1.xls), su tutti i file.
Questo si ottiene con questa nuova Sub Giovani:
Codice: Seleziona tutto
Sub Giovani(Direct As String, Estens As String, Inicell As Range)
  Dim i As Integer, f As String, FSO As Object
  Set FSO = CreateObject("Scripting.FileSystemObject")
  ChDir Direct
  f = Dir(Estens)
  If f = "" Then Exit Sub
  While f <> ""
    If f <> ThisWorkbook.Name Then
        Application.Workbooks.Open perc & "\" & f
        URF = Workbooks(f).Worksheets("GIOVANI").Range("A" & Rows.Count).End(xlUp).Row
        URR = Workbooks(WB1).Worksheets(Ws1).ListObjects(1).ListColumns(1).Range.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
        UR = Workbooks(WB1).Worksheets("FILE_COPIATI").ListObjects(1).ListColumns(1).Range.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
        Workbooks(f).ActiveSheet.ListObjects(1).DataBodyRange.Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1)
        Workbooks(f).Close savechanges:=False
reRand:
        myrand = Format(Int(Rnd() * 10000), "00000")
        If FSO.fileexists(perc & "\ArchivioInseriti\" & myrand & "_" & f) Then GoTo reRand
        Name (perc & "\" & f) As (perc & "\ArchivioInseriti\" & myrand & "_" & f)    ' Sposta il file
        Workbooks(WB1).Worksheets("FILE_COPIATI").Range("A" & UR + 1) = myrand & "_" & f
'         Resize(Workbooks(WB1).Worksheets("FILE_COPIATI").ListObjects(2).DataBodyRange.Rows.Count, 1) = f   nome file
    End If
    f = Dir
  Wend
ThisWorkbook.RefreshAll 'aggiorna tutto il file con tabelle pivot
Set FSO = Nothing
End Sub

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL 2010] Unione di più files excel in un unico file

Postdi Alededio » 28/05/15 00:20

Direi che, con l'ultima sub che hai postato, il risutato sembra essere ottimo!
Tornando al vecchio codice, nel caso di file con stesso nome, quello preesistente verrebbe sovrascritto, cosa che non mi va a genio, volendo tenere traccia dei file. Mentre, rinominarli manualmente comporterebbe un lavoro troppo dispendioso in termini di tempo e con un alto rischio di errore, vista la mole di dati che raccoglierò.

Mi pare che tutto funzioni come deve! Apporterò delle modifiche per adattare alle specifiche esigenze, ma l'obbiettivo è stato raggiunto.
Ora non mi resta che preparare le tabelle per elaborare i dati che verranno copiati nel file.

Grazie mille ancora per il tuo prezioso aiuto Anthony, spero di non aver abusato della tua disponibilità! :D
Alededio
Newbie
 
Post: 7
Iscritto il: 21/05/15 23:13


Torna a Applicazioni Office Windows


Topic correlati a "[EXCEL 2010] Unione di più files excel in un unico file":


Chi c’è in linea

Visitano il forum: Nessuno e 52 ospiti