Note: The other languages of the website are Google-translated. Back to English

Come scorrere i file in una directory e copiare i dati in un foglio principale in Excel?

Supponendo che ci siano più cartelle di lavoro di Excel in una cartella e desideri scorrere tutti questi file Excel e copiare i dati dall'intervallo specificato di fogli di lavoro con lo stesso nome in un foglio di lavoro principale in Excel, cosa puoi fare? Questo articolo introduce un metodo per ottenerlo nei dettagli.

Scorri i file in una directory e copia i dati in un foglio principale con codice VBA


Scorri i file in una directory e copia i dati in un foglio principale con codice VBA

Se si desidera copiare i dati specificati nell'intervallo A1: D4 da tutto il foglio1 delle cartelle di lavoro in una determinata cartella a un foglio principale, eseguire le operazioni seguenti.

1. Nella cartella di lavoro creerai un foglio di lavoro principale, premi il tasto altro + F11 chiavi per aprire il Microsoft Visual Basic, Applications Edition finestra.

2. Nel Microsoft Visual Basic, Applications Edition finestra, fare clic inserire > Modulo. Quindi copia sotto il codice VBA nella finestra del codice.

Codice VBA: scorre i file in una cartella e copia i dati in un foglio principale

Sub Merge2MultiSheets()
    Dim xRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook, xWorkBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    xSheetName = "Sheet1"
    xRgStr = "A1:D4"
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            Set xWorkBook = ThisWorkbook
            Set xSheet = xWorkBook.Sheets("New Sheet")
            If xSheet Is Nothing Then
                xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.Count)).Name = "New Sheet"
                Set xSheet = xWorkBook.Sheets("New Sheet")
            End If
            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
            If xFileName = "" Then Exit Sub
            Do Until xFileName = ""
               Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
                Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
                xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
                xFileName = Dir()
                xBook.Close
            Loop
        End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Note::

1). Nel codice, "A1: D4" e "Sheet1"Significa che i dati nell'intervallo A1: D4 di tutto il foglio1 verranno copiati nel foglio principale. E "Nuovo foglio"È il nome del nuovo foglio master creato.
2). I file Excel nella cartella specifica non dovrebbero aprirsi.

3. premi il F5 chiave per eseguire il codice.

4. In apertura Scopri la nostra gamma finestra, selezionare la cartella contenente i file che verranno riprodotti in loop, quindi fare clic su OK pulsante. Vedi screenshot:

Quindi un foglio di lavoro principale denominato "Nuovo foglio" viene creato alla fine della cartella di lavoro corrente. E i dati nell'intervallo A1: D4 di tutti i fogli1 nella cartella selezionata sono elencati all'interno del foglio di lavoro.


Articoli correlati:


I migliori strumenti per la produttività in ufficio

Kutools per Excel risolve la maggior parte dei tuoi problemi e aumenta la tua produttività dell'80%

  • Riutilizzo: Inserisci rapidamente formule complesse, grafici e tutto ciò che hai usato prima; Crittografa celle con password; Crea mailing list e invia email ...
  • Bar Super Formula (modifica facilmente più righe di testo e formula); Layout di lettura (leggi e modifica facilmente un gran numero di celle); Incolla su intervallo filtrato...
  • Unisci celle / righe / colonne senza perdere dati; Contenuto delle celle divise; Combina righe / colonne duplicate... Impedisci celle duplicate; Confronta intervalli...
  • Seleziona Duplica o Unico Righe; Seleziona Righe vuote (tutte le celle sono vuote); Super Find e Fuzzy Find in molte cartelle di lavoro; Selezione casuale ...
  • Copia esatta Più celle senza modificare il riferimento della formula; Riferimenti di creazione automatica a più fogli; Inserisci punti elenco, Caselle di controllo e altro ...
  • Estrai testo, Aggiungi testo, Rimuovi per posizione, Rimuovi spazio; Creare e stampare totali parziali di paging; Converti contenuto e commenti tra celle...
  • Super filtro (salva e applica schemi di filtri ad altri fogli); Ordinamento avanzato per mese / settimana / giorno, frequenza e altro; Filtro speciale in grassetto, corsivo ...
  • Combina cartelle di lavoro e fogli di lavoro; Unisci tabelle in base a colonne chiave; Suddividi i dati in più fogli; Conversione in batch xls, xlsx e PDF...
  • Più di 300 potenti funzionalità. Supporta Office/Excel 2007-2021 e 365. Supporta tutte le lingue. Facile implementazione nella tua azienda o organizzazione. Funzionalità complete Prova gratuita di 30 giorni. Garanzia di rimborso di 60 giorni.
scheda kte 201905

Scheda Office porta l'interfaccia a schede a Office e semplifica notevolmente il lavoro

  • Abilita la modifica e la lettura a schede in Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Apri e crea più documenti in nuove schede della stessa finestra, piuttosto che in nuove finestre.
  • Aumenta la produttività del 50% e riduce ogni giorno centinaia di clic del mouse!
fondo officetab
Commenti (20)
Ancora nessuna valutazione. Puoi essere il primo a votare!
Questo commento è stato fatto dal moderatore sul sito
grazie per il codice vba! Funziona perfettamente! Vorrei sapere qual è il codice se devo invece INCOLLARE COME VALORE? Grazie in anticipo!
Questo commento è stato fatto dal moderatore sul sito
Ciao Lai Ling,
Il codice seguente può aiutarti a risolvere il problema. Grazie per il tuo commento.

Sub Merge2MultiSheets()
Dim xRg come intervallo
Dim xSelItem come variante
Dim xFileDlg come FileDialog
Dim xFileName, xSheetName, xRgStr come stringa
Dim xBook, xWorkBook come cartella di lavoro
Dim xSheet come foglio di lavoro
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
xSheetName = "Sheet1"
xRgStr = "LA1:D4"
Imposta xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Con xFileDlg
Se .Mostra = -1 Allora
xSelItem = .SelectedItems.Item(1)
Imposta xWorkBook = Questa cartella di lavoro
Imposta xSheet = xWorkBook.Sheets ("Nuovo foglio")
Se xSheet non è niente allora
xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Name = "Nuovo foglio"
Imposta xSheet = xWorkBook.Sheets ("Nuovo foglio")
End If
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
Se xFileName = "" Quindi esci da Sub
Fai fino a xFileName = ""
Imposta xBook = Cartelle di lavoro.Apri(xSelItem & "\" & xFileName)
Imposta xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xNomeFile = Dir()
xBook.Chiudi
Ciclo continuo
End If
Fine Con
Imposta xRg = xSheet.UsedRange
xRg.ClearFormats
xRg.UseStandardHeight = Vero
xRg.UseStandardWidth = Vero
Application.DisplayAlerts = Vero
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Questo commento è stato fatto dal moderatore sul sito
Ciao, grazie per il codice. Per favore, puoi farmi sapere come posso includere il nome del file Excel da cui è stato copiato l'intervallo di dati? Questo sarebbe un grande aiuto!

Thank you.
Questo commento è stato fatto dal moderatore sul sito
Ciao,

Grazie per il tutorial.

Come farei: copiare solo la riga in "Foglio1" con i valori dalla riga "totale" e incollare con [nome file] nel foglio di lavoro principale denominato "Nuovo foglio". Notare la riga con Totale può essere diversa in ogni foglio di lavoro.

Per esempio:
File1: Foglio1
Col1, Col2, Colx
1,2,15
Risultato,10,50

File2: Foglio1
Col1, Col2, Colx
1,5,10
2,4,16
3,3,6
4,5,6
5,7,10
Risultato,300,500

MasterFile: "Nuovo foglio":
file 1, 10, 50
file 2, 300, 500
Questo commento è stato fatto dal moderatore sul sito
Ciao, funziona alla grande. C'è un modo per cambiare semplicemente trascinando i valori e non la formula?
Grazie!!
Questo commento è stato fatto dal moderatore sul sito
Ciao Trish,
Il codice seguente può aiutarti a risolvere il problema. Grazie per il tuo commento.

Sub Merge2MultiSheets()
Dim xRg come intervallo
Dim xSelItem come variante
Dim xFileDlg come FileDialog
Dim xFileName, xSheetName, xRgStr come stringa
Dim xBook, xWorkBook come cartella di lavoro
Dim xSheet come foglio di lavoro
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
xSheetName = "Sheet1"
xRgStr = "LA1:D4"
Imposta xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
Con xFileDlg
Se .Mostra = -1 Allora
xSelItem = .SelectedItems.Item(1)
Imposta xWorkBook = Questa cartella di lavoro
Imposta xSheet = xWorkBook.Sheets ("Nuovo foglio")
Se xSheet non è niente allora
xWorkBook.Sheets.Add(after:=xWorkBook.Worksheets(xWorkBook.Worksheets.count)).Name = "Nuovo foglio"
Imposta xSheet = xWorkBook.Sheets ("Nuovo foglio")
End If
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
Se xFileName = "" Quindi esci da Sub
Fai fino a xFileName = ""
Imposta xBook = Cartelle di lavoro.Apri(xSelItem & "\" & xFileName)
Imposta xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
xRg.Copy xSheet.Range("A65536").End(xlUp).Offset(1, 0)
xNomeFile = Dir()
xBook.Chiudi
Ciclo continuo
End If
Fine Con
Imposta xRg = xSheet.UsedRange
xRg.ClearFormats
xRg.UseStandardHeight = Vero
xRg.UseStandardWidth = Vero
Application.DisplayAlerts = Vero
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Questo commento è stato fatto dal moderatore sul sito
Ciao, sta ancora estraendo le formule, non i valori, quindi mi sta dando un errore #REF. So che potrebbe aver bisogno di un .PasteSpecial xlPasteValues ​​da qualche parte, ma non riesco a capire dove. Puoi aiutare? Grazie!
Questo commento è stato fatto dal moderatore sul sito
Ciao Grazie per questo.


Come posso includere il codice per scorrere tutte le cartelle e le sottocartelle ed eseguire la copia sopra?


Grazie!
Questo commento è stato fatto dal moderatore sul sito
Ciao - Questo codice è perfetto per quello che sto cercando di ottenere.

C'è un modo per scorrere tutte le cartelle e le sottocartelle ed eseguire la copia?


Grazie!
Questo commento è stato fatto dal moderatore sul sito
Ciao - Questo codice funziona molto bene per le prime 565 righe per ogni file, ma tutte le righe successive sono sovrapposte al file successivo.
C'è un modo per risolvere questo problema?
Questo commento è stato fatto dal moderatore sul sito
Grazie - come si potrebbe copiare e incollare (valori speciali) da ciascun foglio di lavoro all'interno di una cartella di lavoro in fogli separati all'interno di un file principale principale?
Questo commento è stato fatto dal moderatore sul sito
come si fa a lasciare il codice vuoto se la cella è vuota?
Questo commento è stato fatto dal moderatore sul sito
per me, il nome della scheda "Foglio1" cambia per ciascuno dei miei file. Ad esempio, Tab1, Tab2, Tab3, Tab4... Come posso impostare un ciclo per eseguire un elenco in Excel e continuare a cambiare il nome "Foglio1" finché non viene eseguito tutto?
Questo commento è stato fatto dal moderatore sul sito
Ciao Nick, il codice VBA di seguito può aiutarti a risolvere il problema. Per favore, prova. Sub LoopThroughFileRename()
'Aggiornato da Extendofice 2021/12/31
Dim xRg come intervallo
Dim xSelItem come variante
Dim xFileDlg come FileDialog
Dim xFileName, xSheetName, xRgStr come stringa
Dim xBook, xWorkBook come cartella di lavoro
Dim xSheet come foglio di lavoro
Dim xShs come fogli
Dim xName come stringa
Dim xFNum come intero
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Imposta xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xFileDlg.Show
xSelItem = xFileDlg.SelectedItems.Item(1)
xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
Fai mentre xFileName <> ""
Imposta xWorkBook = Workbooks.Open(xSelItem & "\" & xFileName)
Imposta xShs = xWorkBook.Fogli
Per xFNum = 1 per xShs.Count
Imposta xFoglio = xShs.Item(xFNum)
xNome = xFoglio.Nome
xNome = Sostituisci(xNome, "Foglio""Linguetta") 'Sostituisci foglio con Tab
xFoglio.Nome = xNome
Successiva
xWorkBook.Salva
xWorkBook.Chiudi
xNomeFile = Dir()
Ciclo continuo
Application.DisplayAlerts = Vero
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Questo commento è stato fatto dal moderatore sul sito
Ciao, voglio un codice per copiare i dati in 6 diverse cartelle di lavoro (in una cartella) che ha fogli inclusi in NUOVA PORTA DI LAVORO. in vba
per favore aiutami asp
Questo commento è stato fatto dal moderatore sul sito
Ciao Paranusha,
Lo script VBA nell'articolo seguente può combinare più cartelle di lavoro o fogli di cartelle di lavoro specificati in una cartella di lavoro principale. Si prega di verificare se può aiutare.
Come combinare più cartelle di lavoro in una cartella di lavoro principale in Excel?
Questo commento è stato fatto dal moderatore sul sito
Olá bom dia.
Gostei muito dessde code, ma no me ajudou with the relatórios que eu preciso impreimir.
Preciso imprimir 2.400 relatório de exel que estão em paste differenti e não estão configuradas corretamente per l'impressione. Pode me enviar um códgo de VBA que automatize essas impressionões? Me ajudaria muito, obrigada.
Questo commento è stato fatto dal moderatore sul sito
Ciao Maria Soares,
Si prega di verificare se il codice VBA nel seguente post può essere d'aiuto.
Come stampare più cartelle di lavoro in Excel?
Questo commento è stato fatto dal moderatore sul sito
Il mio scenario è simile, tranne per il fatto che ho più fogli in ogni file, tutti con nomi diversi ma coerenti tra i file. C'è un modo per eseguire il loop di questo codice per copiare i dati all'interno dei file e incollare (valori) in nomi di fogli specifici nella cartella di lavoro principale? I nomi dei fogli nel master sono gli stessi dei file. Voglio scorrere attraverso di loro. Inoltre, la quantità di dati in ogni foglio varierà, quindi dovrò selezionare i dati in ogni foglio usando qualcosa del genere:

Intervallo ("A1").Seleziona
Intervallo (Selezione, Selezione.End (xlDown)). Seleziona
Intervallo(Selezione, Selezione.End(xlToRight)).Seleziona


I nomi dei fogli di file sono donazioni, servizi, assicurazioni, auto, altre spese, ecc...

Grazie in anticipo.
Questo commento è stato fatto dal moderatore sul sito
Ciao Andrea Shahan,
Il seguente codice VBA può risolvere il tuo problema. Dopo aver eseguito il codice e aver selezionato una cartella, il codice abbinerà automaticamente il foglio di lavoro per nome e incollerà i dati nel foglio di lavoro con lo stesso nome nella cartella di lavoro principale.
Sub Merge2MultiSheets()
'Updated by Extendoffice 20221209
    Dim xRg As Range
    Dim xSelItem As Variant
    Dim xFileDlg As FileDialog
    Dim xFileName, xSheetName, xRgStr As String
    Dim xBook As Workbook, xMainBook As Workbook
    Dim xSheet As Worksheet
    On Error Resume Next
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set xMainBook = ThisWorkbook
    
    Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    With xFileDlg
        If .Show = -1 Then
            xSelItem = .SelectedItems.Item(1)
            xFileName = Dir(xSelItem & "\*.xlsx", vbNormal)
            If xFileName = "" Then Exit Sub
            
            Do Until xFileName = ""
            Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)

            For Start = 1 To xBook.Worksheets.Count
                Set xSheet = xBook.Worksheets.Item(Start)
                xSheet.Activate
                xSheetName = xSheet.Name
                xSheet.UsedRange.Copy (xMainBook.Worksheets.Item(xSheetName).Range("A1048576").End(xlUp).Offset(1, 0))
            Next
                xFileName = Dir()
                xBook.Close
            Loop
        End If
    End With
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Non ci sono ancora commenti pubblicati qui
Lasciate i vostri commenti
Pubblicazione come ospite
×
Valuta questo post:
0   Personaggi
Posizioni suggerite

Seguici

Copyright © 2009 - www.extendoffice.com. | Tutti i diritti riservati. Offerto da ExtendOffice, | Mappa del sito
Microsoft e il logo Office sono marchi o marchi registrati di Microsoft Corporation negli Stati Uniti e / o in altri paesi.
Protetto da Sectigo SSL