Hoppa till huvudinnehåll

Hur importerar jag flera textfiler från en mapp till ett kalkylblad?

För tillfällen har du här en mapp med flera textfiler. Vad du vill göra är att importera dessa textfiler till ett enda kalkylblad som nedan visas på skärmdumpen. Istället för att kopiera textfilerna en efter en, finns det några knep för att snabbt importera textfilerna från en mapp till ett ark?

Importera flera textfiler från en mapp till ett ark med VBA

Importera textfil till den aktiva cellen med Kutools för Excel bra idé3

Här är en VBA-kod som kan hjälpa dig att importera alla textfiler från en specifik mapp till ett nytt ark.

1. Aktivera en arbetsbok som du vill importera textfiler och tryck på Alt + F11 för att aktivera Microsoft Visual Basic för applikationer fönster.

2. klick Insert > Modulerna, kopiera och klistra in nedanför VBA-koden till Modulerna fönster.

VBA: Importera flera textfiler från en mapp till ett 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. Tryck F5 för att visa en dialogruta och välj en mapp som innehåller textfiler du vill importera. Se skärmdump:
doc importera textfiler från en mapp 1

4. klick OK. Sedan har textfilerna importerats till den aktiva arbetsboken som ett nytt ark separat.
doc importera textfiler från en mapp 2

Om du vill importera en textfil till en viss cell eller ett visst område kan du ansöka Kutools för ExcelÄr Infoga fil på markören verktyg.

Kutools för Excel, med mer än 300 praktiska funktioner, gör dina jobb enklare. 
Gratis nedladdning
gratis fullfjädrad på 30 dagar

Efter gratis installation Kutools för Excel, gör så här:

1. Välj en cell som du vill importera textfilen och klicka på Kutools Plus > Import Export > Infoga fil på markören. Se skärmdump:
doc importera textfiler från en mapp 3

2. Sedan öppnas en dialogruta, klicka Bläddra för att visa Välj en fil för att infogas i cellmarkörens positionsdialog, välj sedan Textfiler från listrutan och välj sedan textfilen du vill importera. Se skärmdump:
doc importera textfiler från en mapp 4

3. klick Öppen > Ok, och den angivna textfilen har infogats vid markörens position, se skärmdump:
doc importera textfiler från en mapp 5

Bästa kontorsproduktivitetsverktyg

🤖 Kutools AI Aide: Revolutionera dataanalys baserat på: Intelligent utförande   |  Generera kod  |  Skapa anpassade formler  |  Analysera data och generera diagram  |  Anropa Kutools funktioner.
Populära funktioner: Hitta, markera eller identifiera dubbletter   |  Ta bort tomma rader   |  Kombinera kolumner eller celler utan att förlora data   |   Rund utan formel ...
Superuppslag: Flera kriterier VLookup  |   VLookup med flera värden  |   VSök över flera ark   |   Fuzzy Lookup ....
Avancerad rullgardinslista: Skapa snabbt en rullgardinslista   |  Beroende rullgardinslista   |  Flervals-rullgardinslista ....
Kolumnhanterare: Lägg till ett specifikt antal kolumner  |  Flytta kolumner  |  Växla synlighetsstatus för dolda kolumner  |  Jämför intervall och kolumner ...
Utvalda funktioner: Rutnätsfokus   |  Designvy   |   Stor formelbar   |  Arbetsbok & Bladhanterare   |  Resursbibliotek (Automatisk text)   |  Datumväljare   |  Kombinera arbetsblad   |  Kryptera/Dekryptera celler   |  Skicka e-postmeddelanden efter lista   |  Superfilter   |   Specialfilter (filtrera fet/kursiv/genomstruken...) ...
Topp 15 verktygssatser:  12 text verktyg (lägga till text, Ta bort tecken, ...)   |   50+ Diagram Typer (Gantt Chart, ...)   |   40+ Praktiskt Formler (Beräkna ålder baserat på födelsedag, ...)   |   19 Införande verktyg (Infoga QR-kod, Infoga bild från sökväg, ...)   |   12 Konvertering verktyg (Siffror till ord, Valutaväxling, ...)   |   7 Slå ihop och dela verktyg (Avancerade kombinera rader, Dela celler, ...)   |   ... och mer

Uppgradera dina Excel-färdigheter med Kutools för Excel och upplev effektivitet som aldrig förr. Kutools för Excel erbjuder över 300 avancerade funktioner för att öka produktiviteten och spara tid.  Klicka här för att få den funktion du behöver mest...

Beskrivning

Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje 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