VBA Combina più file Excel in una cartella di lavoro

Questo tutorial ti mostrerà come combinare più file Excel in una cartella di lavoro in VBA

La creazione di una singola cartella di lavoro da una serie di cartelle di lavoro utilizzando VBA richiede l'esecuzione di una serie di passaggi.

  • È necessario selezionare le cartelle di lavoro da cui si desiderano i dati di origine: i file di origine.
  • È necessario selezionare o creare la cartella di lavoro in cui si desidera inserire i dati: il file di destinazione.
  • È necessario selezionare i fogli dai file di origine richiesti.
  • Devi dire al codice dove posizionare i dati nel file di destinazione.

Combinazione di tutti i fogli di tutte le cartelle di lavoro aperte in una nuova cartella di lavoro come fogli singoli

Nel codice seguente, i file di cui hai bisogno per copiare le informazioni devono essere aperti poiché Excel scorrerà i file aperti e copierà le informazioni in una nuova cartella di lavoro. Il codice viene inserito nella cartella di lavoro macro personale.

Questi file sono gli SOLO file Excel che dovrebbero essere aperti.

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647 Sub CombinaMultipleFiles()In caso di errore GoTo eh'dichiarare variabili per contenere gli oggetti richiestiDim wbDestination come cartella di lavoroDim wbSource come cartella di lavoroDim wsSource As WorksheetDim wb come cartella di lavoroDim sh come foglio di lavoroDim strSheetName As StringDim strDestName As String'spegni l'aggiornamento dello schermo per velocizzare le coseApplication.ScreenUpdating = False'prima crea una nuova cartella di lavoro di destinazioneImposta wbDestination = Workbooks.Add'ottieni il nome della nuova cartella di lavoro in modo da escluderla dal ciclo sottostantestrDestName = wbDestination.Name'ora scorri ciascuna delle cartelle di lavoro aperte per ottenere i dati ma escludi il tuo nuovo libro o la cartella di lavoro macro personalePer ogni wb in Application.WorkbooksSe wb.Name strDestName e wb.Name "PERSONAL.XLSB" AlloraImposta wbSource = wbPer ogni sh In wbSource.Worksheetssh.Copy After:=Workbooks(strDestName).Sheets(1)prossimo shFinisci sewb successivo'ora chiudi tutti i file aperti tranne il nuovo file e la cartella di lavoro della macro personale.Per ogni wb in Application.WorkbooksSe wb.Name strDestName e wb.Name "PERSONAL.XLSB" Allorawb.Chiudi FalsoFinisci sewb successivo'rimuovi il foglio uno dalla cartella di lavoro di destinazioneApplication.DisplayAlerts = FalseFogli("Foglio1").EliminaApplication.DisplayAlerts = True'ripulire gli oggetti per liberare la memoriaImposta wbDestination = NienteImposta wbSource = NienteImposta wsSource = NienteImposta wb = Niente'accendi l'aggiornamento dello schermo al termineApplication.ScreenUpdating = FalseEsci Sottoehi:MsgBox Err.DescrizioneFine sottotitolo

Fare clic sulla finestra di dialogo Macro per eseguire la procedura dalla schermata di Excel.

Il tuo file combinato verrà ora visualizzato.

Questo codice ha eseguito il loop di ogni file e ha copiato il foglio in un nuovo file. Se uno dei tuoi file ha più di un foglio, copierà anche quelli, inclusi i fogli senza nulla!

Combinazione di tutti i fogli di tutte le cartelle di lavoro aperte in un singolo foglio di lavoro in una nuova cartella di lavoro

La procedura seguente combina le informazioni di tutti i fogli in tutte le cartelle di lavoro aperte in un unico foglio di lavoro in una nuova cartella di lavoro creata.

Le informazioni di ciascun foglio vengono incollate nel foglio di destinazione nell'ultima riga occupata del foglio di lavoro.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869 Sotto CombinaPiùFogli()In caso di errore GoTo eh'dichiarare variabili per contenere gli oggetti richiestiDim wbDestination come cartella di lavoroDim wbSource come cartella di lavoroDim wsDestination As WorksheetDim wb come cartella di lavoroDim sh come foglio di lavoroDim strSheetName As StringDim strDestName As StringDim iRws As IntegerDim iCols As IntegerDim totRws As IntegerDim strEndRng As StringDim rngSource As Range'spegni l'aggiornamento dello schermo per velocizzare le coseApplication.ScreenUpdating = False'prima crea una nuova cartella di lavoro di destinazioneImposta wbDestination = Workbooks.Add'ottieni il nome della nuova cartella di lavoro in modo da escluderla dal ciclo sottostantestrDestName = wbDestination.Name'ora scorre ciascuna delle cartelle di lavoro aperte per ottenere i datiPer ogni wb in Application.WorkbooksSe wb.Name strDestName e wb.Name "PERSONAL.XLSB" AlloraImposta wbSource = wbPer ogni sh In wbSource.Worksheets'ottieni il numero di righe e colonne nel fogliosh.AttivaActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).AttivaiRws = ActiveCell.RowiCols = ActiveCell.Column'imposta l'intervallo dell'ultima cella nel fogliostrEndRng = sh.Cells(iRws, iCols).Address'imposta l'intervallo di origine da copiareImposta rngSource = sh.Range("A1:" & strEndRng)'trova l'ultima riga nel foglio di destinazionewbDestination.ActivateImposta wsDestination = ActiveSheetwsDestination.Cells.SpecialCells(xlCellTypeLastCell).SelecttotRws = ActiveCell.Row'controlla se ci sono abbastanza righe per incollare i datiSe totRws + rngSource.Rows.Count > wsDestination.Rows.Count ThenMsgBox "Non ci sono abbastanza righe per inserire i dati nel foglio di lavoro Consolidamento."Vai a ehFinisci se'aggiungi una riga da incollare nella riga successiva in bassoSe totRws 1 Allora totRws = totRws + 1rngSource.Copy Destinazione:=wsDestination.Range("A" & totRws)prossimo shFinisci sewb successivo'ora chiudi tutti i file aperti tranne quello che vuoiPer ogni wb in Application.WorkbooksSe wb.Name strDestName e wb.Name "PERSONAL.XLSB" Allorawb.Chiudi FalsoFinisci sewb successivo'ripulire gli oggetti per liberare la memoriaImposta wbDestination = NienteImposta wbSource = NienteImposta wsDestination = NienteImposta rngSource = NienteImposta wb = Niente'accendi l'aggiornamento dello schermo al termineApplication.ScreenUpdating = FalseEsci Sottoehi:MsgBox Err.DescrizioneFine sottotitolo

Combinazione di tutti i fogli di tutte le cartelle di lavoro aperte in un singolo foglio di lavoro in una cartella di lavoro attiva

Se desideri trasferire le informazioni da tutte le altre cartelle di lavoro aperte a quella in cui stai attualmente lavorando, puoi utilizzare questo codice di seguito.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081 Sub CombineMultipleSheetsToExisting()In caso di errore GoTo eh'dichiarare variabili per contenere gli oggetti richiestiDim wbDestination come cartella di lavoroDim wbSource come cartella di lavoroDim wsDestination As WorksheetDim wb come cartella di lavoroDim sh come foglio di lavoroDim strSheetName As StringDim strDestName As StringDim iRws As IntegerDim iCols As IntegerDim totRws As IntegerDim rngEnd As StringDim rngSource As Range'imposta l'oggetto cartella di lavoro attivo per il libro di destinazioneImposta wbDestination = ActiveWorkbook'ottieni il nome del file attivostrDestName = wbDestination.Name'spegni l'aggiornamento dello schermo per velocizzare le coseApplication.ScreenUpdating = False'prima crea un nuovo foglio di lavoro di destinazione nella cartella di lavoro attivaApplication.DisplayAlerts = False'riprendi il prossimo errore se il foglio del caso non esisteIn caso di errore Riprendi AvantiActiveWorkbook.Sheets("Consolidamento").Elimina'reimposta trap di errori per andare alla fine di trap di erroriIn caso di errore GoTo ehApplication.DisplayAlerts = True'aggiungi un nuovo foglio alla cartella di lavoroCon ActiveWorkbookImposta wsDestination = .Sheets.Add(After:=.Sheets(.Sheets.Count))wsDestination.Name = "Consolidamento"Termina con'ora scorrere ciascuna delle cartelle di lavoro aperte per ottenere i datiPer ogni wb in Application.WorkbooksSe wb.Name strDestName e wb.Name "PERSONAL.XLSB" AlloraImposta wbSource = wbPer ogni sh In wbSource.Worksheets'ottieni il numero di righe nel fogliosh.AttivaActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).AttivaiRws = ActiveCell.RowiCols = ActiveCell.ColumnrngEnd = sh.Cells(iRws, iCols).AddressImposta rngSource = sh.Range("A1:" & rngEnd)'trova l'ultima riga nel foglio di destinazionewbDestination.ActivateImposta wsDestination = ActiveSheetwsDestination.Cells.SpecialCells(xlCellTypeLastCell).SelecttotRws = ActiveCell.Row'controlla se ci sono abbastanza righe per incollare i datiSe totRws + rngSource.Rows.Count > wsDestination.Rows.Count ThenMsgBox "Non ci sono abbastanza righe per inserire i dati nel foglio di lavoro Consolidamento."Vai a ehFinisci se'aggiungi una riga da incollare sulla riga successiva in basso se non sei nella riga 1Se totRws 1 Allora totRws = totRws + 1rngSource.Copy Destinazione:=wsDestination.Range("A" & totRws)prossimo shFinisci sewb successivo'ora chiudi tutti i file aperti tranne quello che vuoiPer ogni wb in Application.WorkbooksSe wb.Name strDestName e wb.Name "PERSONAL.XLSB" Allorawb.Chiudi FalsoFinisci sewb successivo'ripulire gli oggetti per liberare la memoriaImposta wbDestination = NienteImposta wbSource = NienteImposta wsDestination = NienteImposta rngSource = NienteImposta wb = Niente'accendi l'aggiornamento dello schermo al termineApplication.ScreenUpdating = FalseEsci Sottoehi:MsgBox Err.DescrizioneFine sottotitolo

Aiuterete lo sviluppo del sito, condividere la pagina con i tuoi amici

wave wave wave wave wave