Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

[EXCEL 2013] Unire più file excel in uno

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

Re: [EXCEL 2013] Unire più file excel in uno

Postdi Telex » 05/10/16 17:40

Scusami per la poca chiarezza.
Ho utilizzato la macro proposta inizialmente in questa discussione che prevede:
1) l'importazione dei dati del "Foglio1" di tutti i file Excel contenuti nella stessa cartella del file Riepilogo (che contiene la macro
2) crea una cartella ArchivioXls (se non esiste)
3) trasferisce i file processati nella cartella Archivio per evitare di processarli di nuovo.
La macro assomma tutti i fogli che si chiamano "Foglio1" nel "foglio1" del file di arrivo.
Il tutto funziona e va bene.
La mia esigenza aggiuntiva è quella di unire in un unico file/foglio tutti i fogli presenti sui file sorgenti a prescindere dal nome del foglio (un file sorgente può contenere più fogli e vanno tutti importati).
Inoltre per meglio comprendere la sorgente dei dati ho esigenza che il nome del foglio importato appaia sulla prima colonna di ogni riga importata.
Grazie.


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
Codice: Seleziona tutto
Sub ElencoFile(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("Foglio1").Range("A" & Rows.Count).End(xlUp).Row
        URR = Workbooks(WB1).Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row
        Workbooks(f).ActiveSheet.Rows("1:" & 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
[code]
Telex
Newbie
 
Post: 4
Iscritto il: 04/10/16 14:05

Sponsor
 

Re: [EXCEL 2013] Unire più file excel in uno

Postdi Anthony47 » 05/10/16 23:52

Allora dovrebbe bastere sostituire nella seconda macro questo pezzo
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("1:" & 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
con questo:
Codice: Seleziona tutto
    If f <> ThisWorkbook.Name Then
        Application.Workbooks.Open perc & "\" & f
        For MI = 1 To Worksheets.Count
            URF = Workbooks(f).Worksheets(MI).Range("A" & Rows.Count).End(xlUp).Row
            URR = Workbooks(WB1).Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row
            Workbooks(f).Worksheets(MI).Rows("1:" & URF).Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1)
        Next MI
        Workbooks(f).Close savechanges:=False
        FileCopy perc & "\" & f, perc & "\ArchivioXls\" & f
            Kill perc & "\" & f
    End If

Fai sapere...
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13899
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL 2013] Unire più file excel in uno

Postdi Telex » 06/10/16 15:46

La macro qui riportata adesso legge tutti i fogli dei vari file proposti nella directory.
Non aggiunge la colonna iniziale con il nome del foglio di provenienza.

Ciao
telex

Codice: Seleziona tutto
Public perc 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 = 1
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
  ChDir Direct
  f = Dir(Estens)
  Ws1 = 1
  If f = "" Then Exit Sub
  While f <> ""
        If f <> ThisWorkbook.Name Then
        Application.Workbooks.Open perc & "\" & f
        For MI = 1 To Worksheets.Count
            URF = Workbooks(f).Worksheets(MI).Range("A" & Rows.Count).End(xlUp).Row
            URR = Workbooks(WB1).Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row
            Workbooks(f).Worksheets(MI).Rows("1:" & URF).Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1)
        Next MI
        Workbooks(f).Close savechanges:=False
        FileCopy perc & "\" & f, perc & "\ArchivioXls\" & f
            Kill perc & "\" & f
    End If
    f = Dir
  Wend
End Sub

Telex
Newbie
 
Post: 4
Iscritto il: 04/10/16 14:05

Re: [EXCEL 2013] Unire più file excel in uno

Postdi Anthony47 » 06/10/16 22:04

Prego
Per l'altra richiesta (per la verita' gia' scritta nei post precedenti), dovrai modificare questa parte
Workbooks(f).Worksheets(MI).Rows("1:" & URF).Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1)
In
Codice: Seleziona tutto
            Workbooks(f).Worksheets(MI).Cells(1, 1).Resize(URF, Columns.Count - 10).Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("B" & URR + 1)
            Application.CutCopyMode = False
            Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1).Resize(URF, 1).Value = Workbooks(f).Worksheets(MI).Name

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13899
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL 2013] Unire più file excel in uno

Postdi Telex » 07/10/16 09:45

GRAZIE!
Funziona tutto perfettamente.
Allego la Macro completa di cui riassumo le funzioni:
1) accorpa in sequenza in un unico foglio Excel le righe compilate di tutti i fogli esistenti nei file contenuti nella stessa cartella del file da cui si esegue la macro.
2) Sulla prima colonna del foglio di destinazione per ogni riga inserita viene segnato il nome del foglio di provenienza
3) ogni file elaborato viene spostato nella cartella ArchivioXls che va creata preventivamente.

Codice: Seleziona tutto
Public perc 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 = 1
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
  ChDir Direct
  f = Dir(Estens)
  Ws1 = 1
  If f = "" Then Exit Sub
  While f <> ""
        If f <> ThisWorkbook.Name Then
        Application.Workbooks.Open perc & "\" & f
        For MI = 1 To Worksheets.Count
            URF = Workbooks(f).Worksheets(MI).Range("A" & Rows.Count).End(xlUp).Row
            URR = Workbooks(WB1).Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row
            Workbooks(f).Worksheets(MI).Cells(1, 1).Resize(URF, Columns.Count - 10).Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("B" & URR + 1)
            Application.CutCopyMode = False
            Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1).Resize(URF, 1).Value = Workbooks(f).Worksheets(MI).Name
        Next MI
        Workbooks(f).Close savechanges:=False
        FileCopy perc & "\" & f, perc & "\ArchivioXls\" & f
            Kill perc & "\" & f
    End If
    f = Dir
  Wend
End Sub

Telex
Newbie
 
Post: 4
Iscritto il: 04/10/16 14:05

Re: [EXCEL 2013] Unire più file excel in uno

Postdi Sbobo » 17/11/16 10:30

Telex ha scritto:GRAZIE!
Funziona tutto perfettamente.
Allego la Macro completa di cui riassumo le funzioni:
1) accorpa in sequenza in un unico foglio Excel le righe compilate di tutti i fogli esistenti nei file contenuti nella stessa cartella del file da cui si esegue la macro.
2) Sulla prima colonna del foglio di destinazione per ogni riga inserita viene segnato il nome del foglio di provenienza
3) ogni file elaborato viene spostato nella cartella ArchivioXls che va creata preventivamente.

Codice: Seleziona tutto
Public perc 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 = 1
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
  ChDir Direct
  f = Dir(Estens)
  Ws1 = 1
  If f = "" Then Exit Sub
  While f <> ""
        If f <> ThisWorkbook.Name Then
        Application.Workbooks.Open perc & "\" & f
        For MI = 1 To Worksheets.Count
            URF = Workbooks(f).Worksheets(MI).Range("A" & Rows.Count).End(xlUp).Row
            URR = Workbooks(WB1).Worksheets(Ws1).Range("A" & Rows.Count).End(xlUp).Row
            Workbooks(f).Worksheets(MI).Cells(1, 1).Resize(URF, Columns.Count - 10).Copy Destination:=Workbooks(WB1).Worksheets(Ws1).Range("B" & URR + 1)
            Application.CutCopyMode = False
            Workbooks(WB1).Worksheets(Ws1).Range("A" & URR + 1).Resize(URF, 1).Value = Workbooks(f).Worksheets(MI).Name
        Next MI
        Workbooks(f).Close savechanges:=False
        FileCopy perc & "\" & f, perc & "\ArchivioXls\" & f
            Kill perc & "\" & f
    End If
    f = Dir
  Wend
End Sub




Ho utilizzato questa fantastica MACRO però ho un problema..
Quando vado a inserire tutti i file ai quali devo fare il MERGE dentro la cartella chiamata "Test" da un file .xls presente nella stessa cartella , dopo aver avviato la macro mi sposta i 6 file all'interno della cartella Test e il file dove tutti i dati sono stati uniti fuori la cartella... Come mai??

Sorgente : C:\Users\utente\Desktop\Test -- Qui ci sono tutti i file , quelli da unire e quello dove vanno uniti..

Dopo Macro

Sorgente : C:\Users\utente\Desktop\Test -- Solo il file con tutte le unioni mentre gli altri 6 file sono C:\Users\utente\Desktop\Test\Test , quindi se volessi rieseguire la macro non li trova... :eeh:

Dove sbaglio??
Grazie.
Sbobo
Newbie
 
Post: 1
Iscritto il: 17/11/16 10:25

Re: [EXCEL 2013] Unire più file excel in uno

Postdi Anthony47 » 17/11/16 13:18

Ciao Sbobo, benvenuto nel forum.
Credo che per capire quello che dici bisognerebbe leggere i 44 messaggi precedenti al tuo...
Ti suggerirei invece di aprire una nuova descrizione, spiegando nei dettagli quello che hai bisogno di fare; valuta se utile allegare anche un file di test; i "suggerimenti della regia" in merito recitano:
"Se i dati da elaborare sono particolari o richiedono piu' di 2 (due) minuti per essere ricreati da chi vuole aiutarvi, allora e' bene allegare un file esemplificativo. Usate la procedura descritta in questo messaggio: viewtopic.php?f=26&t=103893&p=605487#p605487"

Ti aspettiamo...
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13899
Iscritto il: 21/03/06 16:03
Località: Ivrea

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "[EXCEL 2013] Unire più file excel in uno":


Chi c’è in linea

Visitano il forum: alfrimpa e 17 ospiti