Gå til hovedindhold

Hvordan importeres flere tekstfiler fra en mappe til et regneark?

For eksempel har du her en mappe med flere tekstfiler, hvad du vil gøre er at importere disse tekstfiler til et enkelt regneark som vist nedenfor i skærmbilledet. I stedet for at kopiere tekstfilerne en efter en, er der nogle tricks til hurtigt at importere tekstfilerne fra en mappe til et ark?

Importer flere tekstfiler fra en mappe til et enkelt ark med VBA

Importer tekstfil til den aktive celle med Kutools til Excel god idé3

Her er en VBA-kode, der kan hjælpe dig med at importere alle tekstfiler fra en bestemt mappe til et nyt ark.

1. Aktivér en projektmappe, du vil importere tekstfiler, og tryk på Alt + F11 taster for at aktivere Microsoft Visual Basic til applikationer vindue.

2. klik indsatte > Moduler, kopier og indsæt nedenunder VBA-kode til Moduler vindue.

VBA: Importer flere tekstfiler fra en mappe til et ark

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. Trykke F5 for at få vist en dialog og vælge en mappe, der indeholder tekstfiler, du vil importere. Se skærmbillede:
doc importerer tekstfiler fra en mappe 1

4. klik OK. Derefter er tekstfilerne importeret til den aktive projektmappe som nyt ark separat.
doc importerer tekstfiler fra en mappe 2

Hvis du vil importere en tekstfil til en bestemt celle eller et bestemt område, kan du anvende Kutools til Excel's Indsæt fil på markøren nytte.

Kutools til Excel, med mere end 300 praktiske funktioner, der gør dine job lettere. 
Gratis download
gratis fuld funktion på 30 dage

Efter gratis installation Kutools til Excel, gør venligst som nedenfor:

1. Vælg en celle, du vil importere tekstfilen, og klik på Kutools Plus > Import Eksport > Indsæt fil på markøren. Se skærmbillede:
doc importerer tekstfiler fra en mappe 3

2. Derefter vises en dialogboks, klik Gennemse for at vise Vælg en fil skal indsættes i cellemarkørens placeringsdialog, vælg derefter Tekstfiler fra rullelisten, og vælg derefter den tekstfil, du vil importere. Se skærmbillede:
doc importerer tekstfiler fra en mappe 4

3. klik Åbne > Ok, og den angivne tekstfil er indsat ved markørpositionen, se skærmbillede:
doc importerer tekstfiler fra en mappe 5

Bedste kontorproduktivitetsværktøjer

🤖 Kutools AI Aide: Revolutionér dataanalyse baseret på: Intelligent udførelse   |  Generer kode  |  Opret brugerdefinerede formler  |  Analyser data og generer diagrammer  |  Aktiver Kutools funktioner...
Populære funktioner: Find, fremhæv eller identificer dubletter   |  Slet tomme rækker   |  Kombiner kolonner eller celler uden at miste data   |   Runde uden formel ...
Super opslag: VLookup med flere kriterier  |   Multiple Value VLookup  |   VOpslag på tværs af flere ark   |   Fuzzy Lookup ....
Avanceret rulleliste: Opret hurtigt rulleliste   |  Afhængig rulleliste   |  Multivælg rulleliste ....
Column Manager: Tilføj et bestemt antal kolonner  |  Flyt kolonner  |  Skift synlighedsstatus for skjulte kolonner  |  Sammenlign områder og kolonner ...
Fremhævede funktioner: Grid fokus   |  Designvisning   |   Stor Formel Bar   |  Arbejdsbog & Ark Manager   |  Ressourcebibliotek (Autotekst)   |  Datovælger   |  Kombiner regneark   |  Krypter/Dekrypter celler   |  Send e-mails efter liste   |  Superfilter   |   Specielt filter (filter fed/kursiv/gennemstreget...) ...
Top 15 værktøjssæt:  12 tekst Værktøjer (tilføje tekst, Fjern tegn, ...)   |   50 + Chart Typer (Gantt kort, ...)   |   40+ Praktisk formler (Beregn alder baseret på fødselsdag, ...)   |   19 Indsættelse Værktøjer (Indsæt QR-kode, Indsæt billede fra sti, ...)   |   12 Konvertering Værktøjer (Tal til ord, Valutaomregning, ...)   |   7 Flet og del Værktøjer (Avancerede kombinere rækker, Opdel celler, ...)   |   ... og mere

Overlad dine Excel-færdigheder med Kutools til Excel, og oplev effektivitet som aldrig før. Kutools til Excel tilbyder over 300 avancerede funktioner for at øge produktiviteten og spare tid.  Klik her for at få den funktion, du har mest brug for...

Beskrivelse

Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere

  • Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
  • Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
  • Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
Comments (46)
Rated 4 out of 5 · 1 ratings
daniel.godbout
daniel.godbout
This comment was minimized by the moderator on the site
the below code can split data into columns based on space or tab while importing text file to sheets. But I don't want a separate tab for each txt file i would like them all under once sheet. The information is the same format for each file. . What can be modified to allow this to be all one one sheet instead of each file imported being a new tab any and all help would be appreciated

Sub ImportTextToExcel()
'UpdatebyExtendoffice20180911
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 xIntRow As Long
Dim xFNum, xFArr As Long
Dim xStrValue As String
Dim xRg As Range
Dim xArr
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
On Error Resume Next
Application.ScreenUpdating = False
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)

ActiveSheet.Name = xWb.Name

xWb.Close False
xIntRow = ActiveCell.CurrentRegion.Rows.Count
For xFNum = 1 To xIntRow
Set xRg = ActiveSheet.Range("A" & xFNum)
xArr = Split(xRg.Text, " ")
If UBound(xArr) > 0 Then
For xFArr = 0 To UBound(xArr)
If xArr(xFArr) <> "" Then
xRg.Value = xArr(xFArr)
Set xRg = xRg.Offset(ColumnOffset:=1)
End If
Next
End If
Next
Next
End If
Application.ScreenUpdating = True
End Sub
Reply
Report
0
0
Sunny
Sunny     daniel.godbout
This comment was minimized by the moderator on the site
Hi, Daniel, try below code, it import all text files in one sheet named Txt.
Notice that: if the text name is the same with the exisited sheet name, the text file may be not imported.
Sub ImportTextToExcel2()

'UpdatebyExtendoffice20230106

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 xIntRow As Long

Dim xFNum, xFArr As Long

Dim xStrValue As String

Dim xRg As Range

Dim xArr

Dim xRowL, xRowH As Integer

Dim xTxtWS, xWSD As Worksheet

Dim xTxtWS_Rg As Range

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

On Error Resume Next

Set xTxtWS = xToBook.Worksheets("Txt")

If IsNull(xTxtWS) Or IsEmpty(xTxtWS) Then

    Set xTxtWS = xToBook.Worksheets.Add

    xTxtWS.Name = "Txt"

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False

xTxtWS.Activate

If xFiles.Count > 0 Then

xRowL = 1

For I = 1 To xFiles.Count

Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))

xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

Set xWSD = xToBook.Sheets(xToBook.Sheets.Count)

xTxtWS.Activate

xWb.Close False

xIntRow = xWSD.UsedRange.CurrentRegion.Rows.Count

    For xFNum = 1 To xIntRow

        Set xRg = xWSD.Range("A" & xFNum)

        xArr = Split(xRg.Text, " ")

        Set xTxtWS_Rg = xTxtWS.Cells.Range("A" & xRowL)

'        If UBound(xArr) > 0 Then

            For xFArr = 0 To UBound(xArr)

                If xArr(xFArr) <> "" Then

                xTxtWS_Rg.Value = xArr(xFArr)

                Set xTxtWS_Rg = xTxtWS_Rg.Offset(ColumnOffset:=1)

                End If

            Next

'        End If

xRowL = xRowL + 1

    Next

xWSD.Delete

Next

End If

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub
Reply
Report
0
0
Boris
Boris
This comment was minimized by the moderator on the site
This works fine. But when it imports it renames sheets with name.txt how to make it keep only name without adding .txt extension to the sheet?
Reply
0
0
Rated 3.5 out of 5
Boris
Boris     Boris
This comment was minimized by the moderator on the site
Ok nvm found answer with google help.
replace line:
ActiveSheet.Name = xWb.Name
with:
ActiveSheet.Name = Left(xWb.Name,Len(xWb.Name)-4)
would remove last 4 letters from sheet name. Effectively giving me what i needed. name without .txt
Cheers
Reply
0
0
Rated 4 out of 5
Daniel
Daniel
This comment was minimized by the moderator on the site
Hi, thanks for your valuable VBA code.
However, I need a code for multiple txt files into 'a single sheet in the worksheet, not an individual sheet for each txt file'.
What should I edit your code for my purpose?

Thanks,
Reply
0
0
Sunny
Sunny     Daniel
This comment was minimized by the moderator on the site
Hi, please try below code
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
Reply
Report
0
0
ANMOL SARAN
ANMOL SARAN
This comment was minimized by the moderator on the site
In the below code if i want to specify the folder rather than selecting the path everytime import a text file , what modification have have to do

VBA CODE:

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
Reply
0
0
Sunny
Sunny     ANMOL SARAN
This comment was minimized by the moderator on the site
Hi, please try below code
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" is the folder path you may import text file from, please change it as you need.
Reply
Report
0
0
Tom
Tom
This comment was minimized by the moderator on the site
The code works but imports each text file to a new tab in the workbook. Any idea where in the code this could be changed to import the new text file on the same worksheet below the data from the last text file?
Reply
0
0
sadiashahbaz57
sadiashahbaz57
This comment was minimized by the moderator on the site
i need you help i dont have any idea vba excel i want to import multiple text file like 13000. the text file name same as the cell for example (c1=112 so the text file name is also 112) mean the text file 112 is import the c112.
Reply
Report
0
0
sadiashahbaz57
sadiashahbaz57
This comment was minimized by the moderator on the site
0

i need you help i dont have any idea vba excel i want to import multiple text file like 13000. the text file name same as the cell for example (c1=112 so the text file name is also 112) mean the text file 112 is import the c112.
Reply
Report
0
0
Martinho
Martinho
This comment was minimized by the moderator on the site
Hi, my code runs but only imports the first file. It says there was a method error for copy. The debugger highlights the following line of code. Any ideas?


xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
Reply
0
0
Lars
Lars     Martinho
This comment was minimized by the moderator on the site
Hey Martinho,
I had the same Problem and solved it by changing this line:
Set xToBook = ThisWorkbook
to
Set xToBook = ActiveWorkbook
Maybe this helps.
Reply
0
0
Heles
Heles
This comment was minimized by the moderator on the site
thanks a lotdid the job on office 2007 excel
Reply
0
0
Siri_2
Siri_2
This comment was minimized by the moderator on the site
is there any chance for taking sheet names only certain part from txt file names?

as per above code the entire sheet name has been taking.
Reply
Report
0
0
There are no comments posted here yet
Load More
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations