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

Ciao Nicola,

attualmente - come ti sarai certamente accorto - le righe filtrate, ma credo che con il termine 'filtrate' tu intenda le righe nascoste, non sono copiate. 

Solitamente l'esigenza è proprio quella di copiare solamente le righe filtrate ovvero visibili, naturalmente è possibile inserire nella copia anche quelle nascoste.

Se questa è la tua esigenza ... vedremo quello che si può fare.

Answer 2

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

Answer 3

...

 Ho creato un file nella cartella in cui ho i file da estrarre

 Ho inserito in questo file la tua macro

 Nella macro ho solamente inserito il percorso locale con i 2 file da copiare

 Ho lanciato macro

...

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.

Answer 4

...

Grazie a chiunque potrà darmi uno spunto

Ciao Nicola,

il codice allegato è sicuramente più di uno spunto. Adatta i parametri alle tue necessità.

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, lFiles As Long

Dim bCopyHeaders As Boolean, bClearDestination 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

  bClearDestination = True

  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.ClearContents

    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)

      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

---

Ciao Andrea 

grazie per la perentoria risposta.

Ho provato al tua routine in questa maniera: (premetto che è molto articolata per la mia conosenza del VB)

 Ho creato un file nella cartella in cui ho i file da estrarre

 Ho inserito in questo file la tua macro

 Nella macro ho solamente inserito il percorso locale con i 2 file da copiare

 Ho lanciato macro

Risultato finale: la macro gira, mi crea i fogli che mi interessano nel file di destinazione ("wiring list" "device list") ma non copia nulla in questi

Dove sbaglio ?? devo fare qualche altro passaggio ??

Ancora molte grazie

Nicola

Answer 5

...

Grazie a chiunque potrà darmi uno spunto

Ciao Nicola,

il codice allegato è sicuramente più di uno spunto. Adatta i parametri alle tue necessità.

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, lFiles As Long

Dim bCopyHeaders As Boolean, bClearDestination 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

  bClearDestination = True

  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.ClearContents

    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)

      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

---