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

Come importare più file di testo da una cartella in un foglio di lavoro?

Ad esempio, qui hai una cartella con più file di testo, quello che vuoi fare è importare questi file di testo in un singolo foglio di lavoro come mostrato nell'immagine sottostante. Invece di copiare i file di testo uno per uno, esistono dei trucchi per importare rapidamente i file di testo da una cartella in un foglio?

Importa più file di testo da una cartella in un unico foglio con VBA

Importa il file di testo nella cella attiva con Kutools per Excel buona idea 3


Ecco un codice VBA che può aiutarti a importare tutti i file di testo da una cartella specifica in un nuovo foglio.

1. Abilitare una cartella di lavoro in cui si desidera importare file di testo e premere Alt + F11 tasti per abilitare Microsoft Visual Basic, Applications Edition finestra.

2. Clic inserire > Modulo, copia e incolla sotto il codice VBA nel file Modulo finestra.

VBA: importa più file di testo da una cartella a un foglio

Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

3. Stampa F5 per visualizzare una finestra di dialogo e selezionare una cartella che contiene i file di testo che si desidera importare. Vedi screenshot:
doc importare file di testo da una cartella 1

4. Clic OK. Quindi i file di testo sono stati importati separatamente nella cartella di lavoro attiva come nuovo foglio.
doc importare file di testo da una cartella 2


Se desideri importare un file di testo in una cella o intervallo specifico, puoi applicare Kutools for Excel'S Inserisci file al cursore utilità.

Kutools for Excel, con oltre
300
funzioni utili, rende il tuo lavoro più facile. 

Dopo installazione gratuita Kutools per Excel, per favore fai come di seguito:

1. Selezionare una cella in cui si desidera importare il file di testo e fare clic Kutools Plus > Importa / Esporta > Inserisci file al cursore. Vedi screenshot:
doc importare file di testo da una cartella 3

2. Quindi viene visualizzata una finestra di dialogo, fare clic su Scopri la nostra gamma per visualizzare il Seleziona un file da inserire nella finestra di dialogo della posizione del cursore della cella, quindi selezionare File di testo dall'elenco a discesa, quindi scegli il file di testo che desideri importare. Vedi screenshot:
doc importare file di testo da una cartella 4

3. Clic Apri > Ok, e il file di testo specificato è stato inserito nella posizione del cursore, vedi screenshot:
doc importare file di testo da una cartella 5


I migliori strumenti per la produttività in ufficio

Kutools per Excel risolve la maggior parte dei tuoi problemi e aumenta la tua produttività di
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 caratteristiche
    . Supporta Office/Excel
    2007-2019 e 365
    . Supporta tutte le lingue. Facile implementazione nella tua azienda o organizzazione. Funzionalità complete
    30
    prova gratuita di un giorno. 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 tua produttività di
    50%
    e riduce centinaia di clic del mouse per te ogni giorno!
fondo officetab
Commenti (41)
Ancora nessuna valutazione. Puoi essere il primo a votare!
Questo commento è stato fatto dal moderatore sul sito
Sottotest ()
'Aggiorna entroExtendoffice6/7/2016
Dim xWb come cartella di lavoro
Dim xToBook come cartella di lavoro
Dim xStrPath come stringa
Dim xFileDialog come FileDialog
Dim xFile come stringa
Dim xFiles come nuova collezione
Dim I quanto a lungo
Imposta xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Seleziona una cartella [Ktools per Excel]"
Se xFileDialog.Show = -1 Allora
xStrPath = xFileDialog.SelectedItems(1)
End If
Se xStrPath = "" Quindi esci da Sub
If Right(xStrPath, 1) <> "\" Allora xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Se xFile = "" Allora
MsgBox "Nessun file trovato", vbInformation, "Ktools for Excel"
Exit Sub
End If
Fai mentre xFile <> ""
xFiles.Aggiungi xFile, xFile
xFile = Dir()
Ciclo continuo
Imposta xToBook = Questa cartella di lavoro
Se xFiles.Count > 0 Allora
Per I = 1 A xFiles.Count
Imposta xWb = Cartelle di lavoro.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Copia dopo:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
On Error GoTo 0
xWb.Chiudi Falso
Successiva
End If
End Sub

questo codice sta aiutando ma voglio

tab, punto e virgola, spazio vero come fare per favore aiutami
Questo commento è stato fatto dal moderatore sul sito
Vuoi mantenere lo spazio(delimitatori) dopo aver convertito i file di testo in fogli?
Questo commento è stato fatto dal moderatore sul sito
questo è anche il mio problema, questo codice è vero. ma dopo aver convertito i file di testo in Excel, non mantiene i delimitatori.
Questo commento è stato fatto dal moderatore sul sito
Potresti caricare il file di testo e il risultato che vuoi per me?
Questo commento è stato fatto dal moderatore sul sito
Ho lo stesso problema. I file txt sono tutti in fogli separati e il codice ignora lo spazio tra le due colonne
Questo commento è stato fatto dal moderatore sul sito
Ciao, Des e PB Rama Murty, il codice seguente può dividere i dati in colonne in base allo spazio o alla scheda durante l'importazione di file di testo nei fogli. Puoi fare una prova.

Sub ImportTextToExcel()
'Aggiorna entroExtendoffice20180911
Dim xWb come cartella di lavoro
Dim xToBook come cartella di lavoro
Dim xStrPath come stringa
Dim xFileDialog come FileDialog
Dim xFile come stringa
Dim xFiles come nuova collezione
Dim I quanto a lungo
Dim xIntRow quanto più a lungo
Dim xFNum, xFArr quanto più lungo
Dim xStrValue come stringa
Dim xRg come intervallo
Dim xArr
Imposta xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Seleziona una cartella [Ktools per Excel]"
Se xFileDialog.Show = -1 Allora
xStrPath = xFileDialog.SelectedItems(1)
End If
Se xStrPath = "" Quindi esci da Sub
If Right(xStrPath, 1) <> "\" Allora xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Se xFile = "" Allora
MsgBox "Nessun file trovato", vbInformation, "Ktools for Excel"
Exit Sub
End If
Fai mentre xFile <> ""
xFiles.Aggiungi xFile, xFile
xFile = Dir()
Ciclo continuo
Imposta xToBook = Questa cartella di lavoro
On Error Resume Next
Application.ScreenUpdating = False
Se xFiles.Count > 0 Allora

Per I = 1 A xFiles.Count
Imposta xWb = Cartelle di lavoro.Open(xStrPath & xFiles.Item(I))
xWb.Worksheets(1).Copia dopo:=xToBook.Sheets(xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb.Chiudi Falso
xIntRow = ActiveCell.CurrentRegion.Rows.Count
Per xFNum = 1 per xIntRow
Imposta xRg = ActiveSheet.Range ("A" & xFNum)
xArr = Dividi(xRg.Text, " ")
Se UBound(xArr) > 0 Allora
Per xFArr = 0 A UBound(xArr)
Se xArr(xFArr) <> "" Allora
xRg.Value = xArr(xFArr)
Imposta xRg = xRg.Offset(ColumnOffset:=1)
End If
Successiva
End If
Successiva
Successiva
End If
Application.ScreenUpdating = True
End Sub
Questo commento è stato fatto dal moderatore sul sito
Quali modifiche sono necessarie se si desidera dividere i dati in colonne in base alla virgola
Questo commento è stato fatto dal moderatore sul sito
Quali modifiche devono essere apportate se ho bisogno di inserire i dati in colonne in base alla virgola?
Questo commento è stato fatto dal moderatore sul sito
come fare se il mio file Txt contiene delimitato da una virgola?
Questo commento è stato fatto dal moderatore sul sito
Puoi usare Trova e sostituisci fuctuon per sostituire prima la virgola con lo spazio e applicare uno dei metodi precedenti per convertirlo in file Excel.
Questo commento è stato fatto dal moderatore sul sito
Non c'è un modo per cambiarlo nel codice? Dovrei farlo con 130 file
Questo commento è stato fatto dal moderatore sul sito
Stessa domanda
Questo commento è stato fatto dal moderatore sul sito
Per coloro che hanno ancora bisogno di aiuto con questo, sostituire xArr = Split(xRg.Text, " ") con xArr = Split(xRg.Text, ",").
Questo commento è stato fatto dal moderatore sul sito
Quando eseguo il modulo come indicato, aggiunge ogni file .txt come un nuovo foglio, non come una nuova riga al foglio esistente. C'è un modo per ottenerlo come output invece di nuovi fogli per ogni file .txt?
Questo commento è stato fatto dal moderatore sul sito
Intendi combinare tutti i file di testo in un foglio?
Questo commento è stato fatto dal moderatore sul sito
Sì, questo è quello che voglio anche io.
Questo commento è stato fatto dal moderatore sul sito
Ciao, Davinder, puoi provare sotto il codice vba.
Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.txt")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no txt files", , "Kutools for Excel"
End Sub
Questo commento è stato fatto dal moderatore sul sito
Il codice è molto utile, è l'unico codice che ho trovato che ottiene file txt in blocco, la correzione di cui ho bisogno è anche ciò che Joyce e Davinder stanno cercando.
È estrarre i file .txt e incollarli tutti uno sotto l'altro in una colonna specifica, diciamo la colonna 'N'.

Inoltre, è necessario sapere se sarà possibile aggiungere una "condizione if" affinché i file .txt importati siano i seguenti.
se i file .txt iniziano con la lettera 'A' allora da incollare sul 'foglio 1' iniziando con la cella 'N2'
e se i file .txt iniziano con la lettera "B", incollali su "Foglio 2" iniziando con la cella "N2"
altrimenti MsgBox sarà "Scopo del file .txt non riconosciuto".

vi ringrazio in anticipo
Questo commento è stato fatto dal moderatore sul sito
Ho questo codice che ha funzionato per me, ma devo comunque cambiarne alcuni.

* Voglio che incolli sullo stesso foglio senza aprire un nuovo foglio, quindi lo copi perché richiede più tempo.

*necessità di inserire un condizionale se per i file txt importati da incollare sul foglio 1 se inizia con la lettera A e importati nel foglio 2 se inizia con la lettera B


Sottotestcopia3()
Dim xWb come cartella di lavoro
Dim xToBook come cartella di lavoro
Dim xStrPath come stringa
Dim xFileDialog come FileDialog
Dim xFile come stringa
Dim xFiles come nuova collezione
Dim I As Long
Abbassa l'ultima riga finché
Dim Rng come intervallo
Imposta xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Seleziona una cartella [Ktools per Excel]"
Se xFileDialog.Show = -1 Allora
xStrPath = xFileDialog.SelectedItems(1)
End If
Se xStrPath = "" Quindi esci da Sub
If Right(xStrPath, 1) <> "\" Allora xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Se xFile = "" Allora
MsgBox "Nessun file trovato", vbInformation, "Ktools for Excel"
Exit Sub
End If
Fai mentre xFile <> ""
xFiles.Aggiungi xFile, xFile
xFile = Dir()
Ciclo continuo
Intervallo ("N2").Seleziona
Imposta xToBook = Questa cartella di lavoro
Se xFiles.Count > 0 Allora
Per i = 1 a xFiles.Count
Imposta xWb = Cartelle di lavoro.Open(xStrPath & xFiles.Item(i))
xWb.Attiva
'Selezione e copia dei dati txt
Intervallo (Selezione, Selezione.End (xlDown)). Seleziona
Selection.Copy
xToBook.Activate
ActiveSheet.Paste
Selezione.Fine(xlGiù).Offset(1).Seleziona
On Error Resume Next
On Error GoTo 0
xWb.Chiudi Falso
Successiva
End If
End Sub
Questo commento è stato fatto dal moderatore sul sito
Scusa, ho le mani legate
Questo commento è stato fatto dal moderatore sul sito
Ciao, il mio codice funziona ma importa solo il primo file. Dice che si è verificato un errore di metodo per la copia. Il debugger evidenzia la seguente riga di codice. Qualche idea?


xWb.Worksheets(1).Copia dopo:=xToBook.Sheets(xToBook.Sheets.Count)
Questo commento è stato fatto dal moderatore sul sito
Ho lo stesso problema, avete trovato soluzioni?
Questo commento è stato fatto dal moderatore sul sito
Ehi Katie,
So che il tuo commento è piuttosto vecchio, ma ho riscontrato lo stesso problema e l'ho risolto in questo modo: il modulo deve essere inserito in una sottocartella del progetto .xlsx attivo. Ho commesso l'errore di copiare il codice in una sottocartella del mio PERSONAL.XLSB dove di solito memorizzo le mie macro e lo fa con le mie altre macro, ma non con questa.
Questo commento è stato fatto dal moderatore sul sito
Come elimineresti i fogli nel codice vba se non desideri duplicati durante la riesecuzione del modulo?
Questo commento è stato fatto dal moderatore sul sito
Spiacenti, Harsh, fai solo attenzione a evitare l'importazione ripetuta.
Questo commento è stato fatto dal moderatore sul sito
ciao, voglio evitare di rimuovere gli zero precedenti in Excel.

ho provato sotto il codice ma non funziona


Sottotest ()
Dim xWb come cartella di lavoro
Dim xToBook come cartella di lavoro
Dim xStrPath come stringa
Dim xFileDialog come FileDialog
Dim xFile come stringa
Dim xFiles come nuova collezione
Dim I quanto a lungo
Dim j quanto a lungo
Imposta xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Seleziona una cartella"
Se xFileDialog.Show = -1 Allora
xStrPath = xFileDialog.SelectedItems(1)
End If
Se xStrPath = "" Quindi esci da Sub
If Right(xStrPath, 1) <> "\" Allora xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Se xFile = "" Allora
MsgBox "Nessun file trovato", vbInformation, "Ktools for Excel"
Exit Sub
End If
Fai mentre xFile <> ""
xFiles.Aggiungi xFile, xFile
xFile = Dir()
Ciclo continuo
Imposta xToBook = Questa cartella di lavoro
Se xFiles.Count > 0 Allora
Per I = 1 A xFiles.Count
Imposta xWb = Cartelle di lavoro.Open(xStrPath & xFiles.Item(I))
ActiveSheet.Cells.NumberFormat = "@" 'Questo serve per creare Excel in formato testo prima di incollare i dati del file di testo
xWb.Worksheets(1).Copia dopo:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
On Error GoTo 0
xWb.Chiudi Falso
Successiva
End If
End Sub
Questo commento è stato fatto dal moderatore sul sito
Pooja, puoi provare la funzione Rimuovi zeri iniziali di Kutools for Excel per rimuovere tutti gli zeri iniziali dalla selezione dopo l'importazione.
Questo commento è stato fatto dal moderatore sul sito
ma non voglio rimuovere Voglio evitare di rimuovere gli zero precedenti.
Questo commento è stato fatto dal moderatore sul sito
Se vuoi mantenere gli zeri iniziali, puoi formattarli come formato testo da Cell Format.
Questo commento è stato fatto dal moderatore sul sito
Ciao, come modifichi questo codice per inserire i file *.txt nell'ordine: 1,2,3,4,5,6,7,8,9,10,11, ecc. Attualmente il codice inserisce i file come segue:1,10,11,12,13,14,15,16,17,18,19,2,20,21, XNUMX, ecc. Grazie!
Questo commento è stato fatto dal moderatore sul sito
c'è qualche possibilità di prendere i nomi dei fogli solo in parte dai nomi dei file txt?

come da codice sopra è stato preso l'intero nome del foglio.
Questo commento è stato fatto dal moderatore sul sito
grazie mille ha fatto il lavoro in ufficio 2007 excel
Questo commento è stato fatto dal moderatore sul sito
Ciao, il mio codice funziona ma importa solo il primo file. Dice che si è verificato un errore di metodo per la copia. Il debugger evidenzia la seguente riga di codice. Qualche idea?


xWb.Worksheets(1).Copia dopo:=xToBook.Sheets(xToBook.Sheets.Count)
Questo commento è stato fatto dal moderatore sul sito
Ciao Martino,
Ho avuto lo stesso problema e l'ho risolto modificando questa riga:
Imposta xToBook = Questa cartella di lavoro
a
Imposta xToBook = ActiveWorkbook
Forse questo aiuta.
Questo commento è stato fatto dal moderatore sul sito
0

ho bisogno del tuo aiuto non ho idea di vba excel voglio importare più file di testo come 13000. il nome del file di testo è uguale alla cella per esempio (c1=112 quindi anche il nome del file di testo è 112) significa che il file di testo 112 è importare il c112.
Questo commento è stato fatto dal moderatore sul sito
ho bisogno del tuo aiuto non ho idea di vba excel voglio importare più file di testo come 13000. il nome del file di testo è uguale alla cella per esempio (c1=112 quindi anche il nome del file di testo è 112) significa che il file di testo 112 è importare il c112.
Questo commento è stato fatto dal moderatore sul sito
Il codice funziona ma importa ogni file di testo in una nuova scheda della cartella di lavoro. Qualche idea su dove nel codice potrebbe essere modificato per importare il nuovo file di testo sullo stesso foglio di lavoro sotto i dati dell'ultimo file di testo?
Questo commento è stato fatto dal moderatore sul sito
Nel codice seguente se voglio specificare la cartella invece di selezionare il percorso ogni volta che importi un file di testo, quali modifiche devono fare

CODICE VBA:

Sub Import CSVsWithReference()
'Aggiornamento di Kutools per Excel20151214
Dim xSht come foglio di lavoro
Dim xWb come cartella di lavoro
Dim xStrPath come stringa
Dim xFileDialog come FileDialog
Dim xFile come stringa
In errore Vai a ErrHandler
Imposta xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Falso
xFileDialog.Title = "Seleziona una cartella [Ktools per Excel]"
Se xFileDialog.Show = -1 Allora
xStrPath = xFileDialog.SelectedItems(1)
End If
Se xStrPath = "" Quindi esci da Sub
Imposta xSht = ThisWorkbook.ActiveSheet
If MsgBox("Cancella il foglio esistente prima dell'importazione?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
Application.ScreenUpdating = False
xFile = Dir(xStrPath & "\" & "*.txt")
Fai mentre xFile <> ""
Imposta xWb = Cartelle di lavoro.Open(xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
xWb.Chiudi Falso
xFile = Dir
Ciclo continuo
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox "nessun file txt", , "Ktools per Excel"
End Sub
Questo commento è stato fatto dal moderatore sul sito
Ciao, prova sotto il codice
Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    xStrPath = "C:\Users\AddinsVM001\Desktop\test" 'Here is the parth you can modify
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

"C:\Users\AddinsVM001\Desktop\test" è il percorso della cartella da cui puoi importare il file di testo, cambialo se necessario.
Questo commento è stato fatto dal moderatore sul sito
Ciao, grazie per il tuo prezioso codice VBA.
Tuttavia, ho bisogno di un codice per più file txt in "un singolo foglio nel foglio di lavoro, non un singolo foglio per ogni file txt".
Cosa dovrei modificare il tuo codice per il mio scopo?

Grazie,
Questo commento è stato fatto dal moderatore sul sito
Ciao, prova sotto il codice
Sub Test()
    'UpdatebyExtendoffice 10/26/2022
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Dim J As Long
    Dim xRg As Range
    Dim xSaveRg As Range
    Dim xSh As Worksheet
    
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    Set xSh = xToBook.Sheets.Add
    Set xRg = xSh.Range("A1")
    J = 1
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            Set xSaveRg = xWb.Worksheets(1).UsedRange
            J = xSaveRg.Rows.Count + 1 + J
            Debug.Print xRg.Address
            xSaveRg.Copy Destination:=xRg
            On Error Resume Next
            xWb.Close False
            
            Set xRg = xSh.Cells(J, 1)
        Next
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = 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