Unire in excel più fogli di diversi file in un unico foglio di un unico file

Question

Ciao a tutti vi spiego la mia esigenza

ho molteplici file excel, ciascuno con gli stessi fogli (ugualmente titolati). I fogli corrispondenti hanno stesse intestazioni di colonne popolate però con diverso numero di righe.

L'esigenza - come facilmente intuibile - è di ottenere un file finale con con gli stessi fogli contenenti tutte le righe di tutti i fogli dei singoli file.

Al link di seguito due tra i file di cui mi necessita l' "unione" finale.

https://dl.dropboxusercontent.com/u/110044258/excel%20da%20unire.zip 

I fogli da unire sono quelli titolati "wiring list" e "device list"; le righe da riportare nel file unione vanno dalla 3 in poi. Ovviamente metterei tutti i file (file di unione compreso) nella stessa cartella.

Grazie a chiunque potrà darmi uno spunto

Answer 1

Ahimè sì. Ho cancellato/dimenticato una riga.

Dopo questa:

        lTargetLastRow = wsTarget.UsedRange.Rows.Count

aggiungi questa:

        If lTargetLastRow > 1 Then lTargetLastRow = lTargetLastRow + 1

Andrea.

ora sono davvero ok :)

di nuovo grazie tante andrea !!!

Answer 2

...

mi sono accorto però che manca l'ultima riga di ogni foglio copiato ... è possibile ? 

Ahimè sì. Ho cancellato/dimenticato una riga.

Dopo questa:

        lTargetLastRow = wsTarget.UsedRange.Rows.Count

aggiungi questa:

If lTargetLastRow > 1 Then lTargetLastRow = lTargetLastRow + 1

Andrea.

Answer 3

non vorrei abusare troppo ... ma secondo te c'è un modo per riportare il il titolo del file copiato su una qualsiasi colonna (al fondo o all'inizio) in corrispondenza di tutte le righe che copio e incollo ?

... non è una richiesta inusuale, il codice allegato riporta il nome del file nell'ultima colonna di ciascun foglio, sostituiscilo al precedente.

Andrea.

---

Sub ConsolidateMultipleSheets()

Dim wbSource As Workbook, wbTarget As Workbook

Dim wsSource As Worksheet, wsTarget As Worksheet

Dim sFolder As String, sFile As String, sFilter As String

Dim lSourceFirstRow As Long, lSourceLastRow As Long, lTargetLastRow As Long, lTargetLastCol As Long, lFiles As Long

Dim bCopyHeaders As Boolean, bClearDestination As Boolean, bSourceReference As Boolean

Dim vSheets, vSheet

  On Error GoTo Uffa

  '--- cartella contenente i file da copiare

  sFolder = "C:\CartellaContenenteFilesDaCopiare"

  sFilter = "*.xls"

  

  '--- fogli da consolidare

  vSheets = Array("Wiring list", "Device List")

  '--- altri parametri

  bCopyHeaders = True             ' copia riga intestazione

  bClearDestination = True        ' cancella i dati prima di copiare

  bSourceReference = True         ' nome del file copiato nell'ultima colonna

  With Application

      .DisplayAlerts = False

      .EnableEvents = False

      .ScreenUpdating = False

  End With

  Set wbTarget = ThisWorkbook

  '--- crea e pulisce i fogli di destinazione

  On Error Resume Next

  For Each vSheet In vSheets

    Set wsTarget = wbTarget.Sheets(vSheet)

    If wsTarget Is Nothing Then

      Set wsTarget = wbTarget.Worksheets.Add

      wsTarget.Name = vSheet

    End If

    If bClearDestination Then

      wsTarget.Cells.EntireRow.Delete

    End If

    Set wsTarget = Nothing

  Next

  On Error GoTo Uffa

  sFile = Dir(sFolder & sFilter)

  Do While Len(sFile)

    If sFile <> wbTarget.Name Then

      Application.StatusBar = "Copy in progress: " & sFile

      lFiles = lFiles + 1

      Set wbSource = Workbooks.Open(sFolder & sFile, False, True)

      For Each vSheet In vSheets

        Set wsSource = wbSource.Sheets(vSheet)

        Set wsTarget = wbTarget.Sheets(vSheet)

        lSourceFirstRow = 3 + bCopyHeaders

        lSourceLastRow = wsSource.UsedRange.Rows.Count

        lTargetLastRow = wsTarget.UsedRange.Rows.Count

        wsSource.Rows(lSourceFirstRow & ":" & lSourceLastRow).Copy wsTarget.Cells(lTargetLastRow, 1)

        If bSourceReference Then

          With wsTarget

            lTargetLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column + 1

            If lTargetLastRow = 1 Then lTargetLastRow = lTargetLastRow + 1

            .Range(.Cells(lTargetLastRow, lTargetLastCol), .Cells(.UsedRange.Rows.Count, lTargetLastCol)).Value = wbSource.Name

          End With

        End If

      Next

      If bCopyHeaders Then bCopyHeaders = False

      wbSource.Close False

      Set wbSource = Nothing

    End If

    sFile = Dir

  Loop

  Call MsgBox("Consolidamento terminato: " & lFiles & " files copiati.", vbInformation, "Consolidamento Files")

ExitHere:

  With Application

    .StatusBar = False

    .EnableEvents = True

    .ScreenUpdating = True

    .DisplayAlerts = True

  End With

  Exit Sub

Uffa:

  Call MsgBox("Si è verificato il seguente errore:" & vbNewLine & _

              "Error Number: " & Err.Number & vbNewLine & _

              "Description : " & Err.Description & vbNewLine & _

              "File in elaborazione: " & sFile, vbOKOnly + vbCritical, "Error Message")

  On Error GoTo 0

  wbSource.Close False

  Resume ExitHere

End Sub

---

E' proprio quello che mi serviva

mi sono accorto però che manca l'ultima riga di ogni foglio copiato ... è possibile ? 

Nicola

Answer 4

non vorrei abusare troppo ... ma secondo te c'è un modo per riportare il il titolo del file copiato su una qualsiasi colonna (al fondo o all'inizio) in corrispondenza di tutte le righe che copio e incollo ?

... non è una richiesta inusuale, il codice allegato riporta il nome del file nell'ultima colonna di ciascun foglio, sostituiscilo al precedente.

Andrea.

---

Sub ConsolidateMultipleSheets()

Dim wbSource As Workbook, wbTarget As Workbook

Dim wsSource As Worksheet, wsTarget As Worksheet

Dim sFolder As String, sFile As String, sFilter As String

Dim lSourceFirstRow As Long, lSourceLastRow As Long, lTargetLastRow As Long, lTargetLastCol As Long, lFiles As Long

Dim bCopyHeaders As Boolean, bClearDestination As Boolean, bSourceReference As Boolean

Dim vSheets, vSheet

  On Error GoTo Uffa

  '--- cartella contenente i file da copiare

  sFolder = "C:\CartellaContenenteFilesDaCopiare"

  sFilter = "*.xls"

  '--- fogli da consolidare

  vSheets = Array("Wiring list", "Device List")

  '--- altri parametri

  bCopyHeaders = True             ' copia riga intestazione

  bClearDestination = True        ' cancella i dati prima di copiare

  bSourceReference = True         ' nome del file copiato nell'ultima colonna

  With Application

      .DisplayAlerts = False

      .EnableEvents = False

      .ScreenUpdating = False

  End With

  Set wbTarget = ThisWorkbook

  '--- crea e pulisce i fogli di destinazione

  On Error Resume Next

  For Each vSheet In vSheets

    Set wsTarget = wbTarget.Sheets(vSheet)

    If wsTarget Is Nothing Then

      Set wsTarget = wbTarget.Worksheets.Add

      wsTarget.Name = vSheet

    End If

    If bClearDestination Then

      wsTarget.Cells.EntireRow.Delete

    End If

    Set wsTarget = Nothing

  Next

  On Error GoTo Uffa

  sFile = Dir(sFolder & sFilter)

  Do While Len(sFile)

    If sFile <> wbTarget.Name Then

      Application.StatusBar = "Copy in progress: " & sFile

      lFiles = lFiles + 1

      Set wbSource = Workbooks.Open(sFolder & sFile, False, True)

      For Each vSheet In vSheets

        Set wsSource = wbSource.Sheets(vSheet)

        Set wsTarget = wbTarget.Sheets(vSheet)

        lSourceFirstRow = 3 + bCopyHeaders

        lSourceLastRow = wsSource.UsedRange.Rows.Count

        lTargetLastRow = wsTarget.UsedRange.Rows.Count

        wsSource.Rows(lSourceFirstRow & ":" & lSourceLastRow).Copy wsTarget.Cells(lTargetLastRow, 1)

        If bSourceReference Then

          With wsTarget

            lTargetLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column + 1

            If lTargetLastRow = 1 Then lTargetLastRow = lTargetLastRow + 1

            .Range(.Cells(lTargetLastRow, lTargetLastCol), .Cells(.UsedRange.Rows.Count, lTargetLastCol)).Value = wbSource.Name

          End With

        End If

      Next

      If bCopyHeaders Then bCopyHeaders = False

      wbSource.Close False

      Set wbSource = Nothing

    End If

    sFile = Dir

  Loop

  Call MsgBox("Consolidamento terminato: " & lFiles & " files copiati.", vbInformation, "Consolidamento Files")

ExitHere:

  With Application

    .StatusBar = False

    .EnableEvents = True

    .ScreenUpdating = True

    .DisplayAlerts = True

  End With

  Exit Sub

Uffa:

  Call MsgBox("Si è verificato il seguente errore:" & vbNewLine & _

              "Error Number: " & Err.Number & vbNewLine & _

              "Description : " & Err.Description & vbNewLine & _

              "File in elaborazione: " & sFile, vbOKOnly + vbCritical, "Error Message")

  On Error GoTo 0

  wbSource.Close False

  Resume ExitHere

End Sub

---

Answer 5

E' anche quello che ho fatto anch'io, né più né meno, e ... naturalmente funziona.

Posso suggerirti di verificare che sFolder termini con la barra rovesciata e che sFilter contenga l'estensione corretta dei file da elaborare.

Il codice 'conta' anche i file copiati, segnalandolo al termine, fintanto che questo numero è zero significa che non trova alcun file da copiare per uno dei motivi di cui sopra.

Andrea.

Andrea

bastava solo la barra rovesciata nel percorso. 

Sei stato utilissimo e disponibilissimo, davvero grazie

Nicola

Scusami Andrea

non vorrei abusare troppo ... ma secondo te c'è un modo per riportare il il titolo del file copiato su una qualsiasi colonna (al fondo o all'inizio) in corrispondenza di tutte le righe che copio e incollo ?