Condividi:        

Macro Unione più file excel in uno solo

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

Macro Unione più file excel in uno solo

Postdi crissa » 24/01/18 11:00

Ciao a tutti,
premetto di essere una neofita di macro ma grazie a voi ho risolto molte problematiche lavorative.

Ora dovrei unire più file excel presenti in medesima cartella su server aziendale, con medesima struttura, in un riepilogo.
Ho trovato questa magnifica macro creata da Flash30005e modificata secondo la richiesta degli utenti da Anthony47 ma non corrisponde ancora completamente alle mie esigenze.

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


Confermo di avere la necessità che l'unione avvenga partendo dalla riga 7 dei file da copiare.

Avrei però necessità che:

    - Le colonne copiate siano limitate dalla colonna "A" alla colonna "V"
    - Avrei la necessità che la macro sovrascriva la precedente eseguita ricopiando nuovamente tutte le righe dai file di origine (i colleghi aggiorneranno le righe del file a loro appartenente ed io una volta al giorno dovrò aggiornare il mio file "Riepilogo" con le righe eventualmente aggiunte dai colleghi o le modifiche apportate sulle singole celle). In questa macro invece i file lavorati vengono parcheggiati in una cartella sottostante chiamata "Archivioxls"
    - in caso vi siano presenti filtri nei singoli file da lavorare, avrei bisogno che la macro raccolga comunque tutte le righe scritte
    - che tra un file e l'altro nel riepilogo non venga inserita la riga vuota

Spero che qualcuno possa aiutarmi.
Grazie in anticipo
crissa
Newbie
 
Post: 6
Iscritto il: 24/01/18 10:19

Sponsor
 

Re: Macro Unione più file excel in uno solo

Postdi Anthony47 » 24/01/18 22:30

Allora, riepilogo le tue domande (in blu) e la mia interpretazione (in grassetto):
- Le colonne copiate siano limitate dalla colonna "A" alla colonna "V"
Chiaro

- Avrei la necessità che la macro sovrascriva la precedente eseguita ricopiando nuovamente tutte le righe dai file di origine (i colleghi aggiorneranno le righe del file a loro appartenente ed io una volta al giorno dovrò aggiornare il mio file "Riepilogo" con le righe eventualmente aggiunte dai colleghi o le modifiche apportate sulle singole celle). In questa macro invece i file lavorati vengono parcheggiati in una cartella sottostante chiamata "Archivioxls"
Insomma vuoi che il foglio di riepilogo parta da zero, e non accodando al contenuto preesistente. Inoltre i file non devono essere spostati nella directory "Archivioxls"

- in caso vi siano presenti filtri nei singoli file da lavorare, avrei bisogno che la macro raccolga comunque tutte le righe scritte
Chiaro

- che tra un file e l'altro nel riepilogo non venga inserita la riga vuota
Quale riga vuota?


Cio' detto, possiamo lavorare sulla Sub ElencoFile (seconda parte del codice che abbiamo pubblicato) modificandola in questo modo:
Codice: Seleziona tutto
Sub ElencoFile(Direct As String, Estens As String, Inicell As Range)
  Dim i As Integer, f As String, NoPro As String, mOut As String
  Workbooks(WB1).Sheets(WS1).ClearContents
  Application.EnableEvents = False
  f = Dir(Direct & "\" & Estens)
  If f = "" Then Exit Sub
  While f <> ""
    If f <> ThisWorkbook.Name Then
        i = i + 1
        On Error Resume Next
            Application.Workbooks.Open perc & "\" & f
        On Error GoTo 0
        If ActiveWorkbook.Name = f Then
            Worksheets(1).Select
            Worksheets(1).AutoFilterMode = False
            URF = Range("A" & Rows.Count).End(xlUp).Row
            URR = Workbooks(WB1).Worksheets(WS1).Range("A" & Rows.Count).End(xlUp).Row
            Range("A7:V" & URF).Copy Destination:=Workbooks(WB1).Worksheets(WS1).Range("A" & URR + 1)
            Workbooks(f).Close savechanges:=False
        Else
            NoPro = f & vbCrLf
        End If
    End If
    f = Dir
  Wend
mOut = "Completata importazione N° " & i & " files"
If Len(NoPro) > 3 Then mOut = mOut & "Non importati:" & vbCrLf & NoPro
MsgBox (mOut)
Application.EnableEvents = True
End Sub

Ho inserito anche alcune aggiunte per indicare esplicitamente quale foglio dei file che si aprono si andra' a copiare (il foglio #1) e per controllare situazioni che impediscano l'apertura dei file (es ancora in uso da altri utenti), con messaggio finale di completamento processo.

Prova e fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Macro Unione più file excel in uno solo

Postdi crissa » 25/01/18 10:11

Grazie per la risposta, gentilissimo.
Purtroppo lanciando la macro mi da l'errore "Proprietà o metodo non supportati dall'oggetto" ed eseguendo ogni singola istruzione, l'errore me lo da sul passaggio:

Codice: Seleziona tutto
Workbooks(WB1).Sheets(Ws1).ClearContents
crissa
Newbie
 
Post: 6
Iscritto il: 24/01/18 10:19

Re: Macro Unione più file excel in uno solo

Postdi Anthony47 » 25/01/18 13:09

Eh, volevo risparmiare la tastiera e cosi' ho lasciato la formula monca; correggi in
Codice: Seleziona tutto
Workbooks(WB1).Sheets(WS1).Cells.ClearContents


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

Re: Macro Unione più file excel in uno solo

Postdi crissa » 25/01/18 14:44

:)
Perfetto, errore superato.

Ora però lanciando la macro pare che elabori i vari file e fogli (eseguendola dal VB si vede che elabora i file correttamente), mi appare il messaggio "completata importazione n.9 files" ma il risultato nel foglio riepilogo (ovvero da dove lancio la macro) è un foglio bianco.
crissa
Newbie
 
Post: 6
Iscritto il: 24/01/18 10:19

Re: Macro Unione più file excel in uno solo

Postdi Anthony47 » 25/01/18 18:08

Secondo le istruzioni contenute nella Sub ElencoFileXls, la macro crea il riepilogo nel file che contiene la macro, "Foglio1":
WB1 = ThisWorkbook.Name
Ws1 = "Foglio1"


Altra domanda: il codice e' tutto nello stesso "modulo vba"?
Come si chiama questo modulo? (lo leggi nella parte alta colorata della finestra, comincia con "Microsoft Visual Basic, Application Edition ")
Puoi riportare il codice complessivo che stai usando?


Possiamo dare per certo che la colonna A all'interno del primo foglio dei file che vai a consolidare sia costantemente vuota?

Modifica per prova la macro aggiungendo queste due righe in queste posizioni:
Codice: Seleziona tutto
        On Error GoTo 0
        Debug.Print f, ActiveWorkbook.Name      '<<< QUESTA
        If ActiveWorkbook.Name = f Then
            Debug.Print f                       '<<< e QUESTA

Quando esegui la macro, vai nel vba, premi Contr-g per aprire la "finestra Immediata"; copia 7-8 righe delle informazioni visibili e pubblicale nel tuo prossimo messaggio, insieme con i tuoi commenti alle altre osservazioni fatte prima.

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

Re: Macro Unione più file excel in uno solo

Postdi crissa » 26/01/18 10:12

Ciao Anthony47,
questa la macro completa

Codice: Seleziona tutto
Public perc As String, Ws1 As String, f As String, WB1 As String
Sub ElencoFileXls()
Application.ScreenUpdating = False
Application.Calculation = xlManual
perc = ThisWorkbook.Path
If Dir(perc & "\ArchivioXls", vbDirectory) = "" Then
    MkDir (perc & "\ArchivioXls")
End If
WB1 = ThisWorkbook.Name
Ws1 = "Foglio1"
Worksheets(Ws1).Select
Range("A1").Select
  ElencoFile Direct:=perc, Estens:="*.xls*", Inicell:=ActiveCell
    Columns("A:AZ").EntireColumn.AutoFit
    Range("A1").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub ElencoFile(Direct As String, Estens As String, Inicell As Range)
  Dim i As Integer, f As String, NoPro As String, mOut As String
  Workbooks(WB1).Sheets(Ws1).Cells.ClearContents
  Application.EnableEvents = False
  f = Dir(Direct & "\" & Estens)
  If f = "" Then Exit Sub
  While f <> ""
    If f <> ThisWorkbook.Name Then
        i = i + 1
        On Error Resume Next
            Application.Workbooks.Open perc & "\" & f
            On Error GoTo 0
        Debug.Print f, ActiveWorkbook.Name     
        If ActiveWorkbook.Name = f Then
            Debug.Print f                     
       
            Worksheets(1).Select
            Worksheets(1).AutoFilterMode = False
            URF = Range("A" & Rows.Count).End(xlUp).Row
            URR = Workbooks(WB1).Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row
            Range("A7:V" & URF).Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1)
            Workbooks(f).Close savechanges:=False
        Else
            NoPro = f & vbCrLf
        End If
       
    End If
    f = Dir
  Wend
mOut = "Completata importazione N° " & i & " files"
If Len(NoPro) > 3 Then mOut = mOut & "Non importati:" & vbCrLf & NoPro
MsgBox (mOut)
Application.EnableEvents = True
End Sub


Il foglio 1 del file Riepilogo.xls continua a mantenersi completamente vuoto e non crea altri fogli.
Il modulo si chiama "Riepilogo.xlsm - [Foglio1(codice)]"

Nei singoli file la colonna A è sempre popolata a partire dalla riga 6 (titolo). la cella A1 invece è sempre vuota.




Questo è il report

    AUDANO.xlsx AUDANO.xlsx
    AUDANO.xlsx
    CICATELLI.xlsx CICATELLI.xlsx
    CICATELLI.xlsx
    DE LUCA.xlsx DE LUCA.xlsx
    DE LUCA.xlsx
    FERRAIOLI.xlsx FERRAIOLI.xlsx
    FERRAIOLI.xlsx
    IDA.xlsx IDA.xlsx
    IDA.xlsx
    ORLANDO.xlsx ORLANDO.xlsx
    ORLANDO.xlsx
    PAGNANELLI.xlsx PAGNANELLI.xlsx
    PAGNANELLI.xlsx
    PECORARI.xlsx PECORARI.xlsx
    PECORARI.xlsx
    RIVAROLI.xlsx RIVAROLI.xlsx
    RIVAROLI.xlsx

Quindi elabora tutti i miei file.
crissa
Newbie
 
Post: 6
Iscritto il: 24/01/18 10:19

Re: Macro Unione più file excel in uno solo

Postdi crissa » 26/01/18 10:35

Caspita Anthony
mi sono accorta che il codice era su foglio 1 e non su Modulo. :oops:

Ora funziona tutto perfettamente! Sei un grande Grazieeee

Posso chiederti ancora un favore? In realtà io parto dalla riga 7 in quanto nella riga 6 si ripete sempre il Titolo (uguale in tutti i file).
Se inserisco medesimo titolo nel mio foglio riepilogo e poi lancio la macro ovviamente me lo sovrascrive (o meglio, me lo cancella e la prima riga rimane bianca). Secondo te come posso ovviare a questo problemino.

Per carità, anche così mi va benissimo.
crissa
Newbie
 
Post: 6
Iscritto il: 24/01/18 10:19

Re: Macro Unione più file excel in uno solo

Postdi Anthony47 » 26/01/18 16:06

Credo che la cosa piu' semplice sia aggiungere il titolo alla prima occasione. Per questo aggiungi le tre istruzioni if /End If in questa posizione:
Codice: Seleziona tutto
        If ActiveWorkbook.Name = f Then
            Worksheets(1).Select
            Worksheets(1).AutoFilterMode = False
            If i = 1 Then                                                              ' ***AGGIUNGERE Questo If /End If
                Range("A6:V6").Copy Workbooks(WB1).Worksheets(Ws1).Range("A1")
            End If
            URF = Range("A" & Rows.Count).End(xlUp).Row

Togli tutte le righe "Debug.Print", anche se non darebbero fastidio.

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

Re: Macro Unione più file excel in uno solo

Postdi crissa » 29/01/18 13:54

Ora è perfetta
Ancora grazie
crissa
Newbie
 
Post: 6
Iscritto il: 24/01/18 10:19


Torna a Applicazioni Office Windows


Topic correlati a "Macro Unione più file excel in uno solo":


Chi c’è in linea

Visitano il forum: Nessuno e 56 ospiti