メインコンテンツへスキップ

フォルダからXNUMXつのワークシートに複数のテキストファイルをインポートするにはどうすればよいですか？

たとえば、ここには複数のテキストファイルを含むフォルダーがあります。次のスクリーンショットに示すように、これらのテキストファイルをXNUMXつのワークシートにインポートします。 テキストファイルをXNUMXつずつコピーする代わりに、テキストファイルをXNUMXつのフォルダからXNUMXつのシートにすばやくインポートするためのトリックはありますか？

VBAを使用してXNUMXつのフォルダからXNUMXつのシートに複数のテキストファイルをインポートする

Kutools forExcelを使用してテキストファイルをアクティブセルにインポートします 良いアイデア3

これは、XNUMXつの特定のフォルダーから新しいシートにすべてのテキストファイルをインポートするのに役立つVBAコードです。

1.テキストファイルをインポートするワークブックを有効にして、を押します Altキー+ F11 有効にするキー アプリケーション向け Microsoft Visual Basic 窓。

2。 クリック インセット > モジュール、以下のVBAコードをコピーして モジュール 窓。

VBA：XNUMXつのフォルダからXNUMXつのシートに複数のテキストファイルをインポートする

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。 押す F5 ダイアログを表示し、インポートするテキストファイルを含むフォルダを選択します。 スクリーンショットを参照してください：
docはフォルダからテキストファイルをインポートします1

4。 クリック OK。 次に、テキストファイルが新しいシートとして個別にアクティブなワークブックにインポートされました。
docはフォルダからテキストファイルをインポートします2

XNUMXつのテキストファイルを特定のセルまたは範囲にインポートする場合は、 Kutools for Excelさん カーソル位置にファイルを挿入 ユーティリティ。

Kutools for Excel, 以上で 300 便利な機能は、あなたの仕事をより簡単にします。 
無料ダウンロード
30 日間無料でフル機能を利用できる

後 無料インストール Kutools for Excel、以下のようにしてください：

1.テキストファイルをインポートするセルを選択し、をクリックします クツールズプラス > インポート・エクスポート > カーソル位置にファイルを挿入。 スクリーンショットを参照してください：
docはフォルダからテキストファイルをインポートします3

2.次にダイアログが表示され、クリックします ブラウズ を表示する ファイルを選択 セルカーソル位置ダイアログに挿入するには、次に選択します テキストファイル ドロップダウンリストから、インポートするテキストファイルを選択します。 スクリーンショットを参照してください：
docはフォルダからテキストファイルをインポートします4

3。 クリック Open > Ok、および指定したテキストファイルがカーソル位置に挿入されています。スクリーンショットを参照してください。
docはフォルダからテキストファイルをインポートします5

最高のオフィス生産性向上ツール

🤖 Kutools AI アシスタント: 以下に基づいてデータ分析に革命をもたらします。 インテリジェントな実行   |  コードを生成  |  カスタム数式の作成  |  データを分析してグラフを生成する  |  Kutools関数を呼び出す...
人気の機能: 重複を検索、強調表示、または識別する   |  空白行を削除する   |  データを失わずに列またはセルを結合する   |   数式なしのラウンド ...
スーパールックアップ: 複数の基準の VLookup  |   複数の値の VLookup  |   複数のシートにわたる VLookup   |   ファジールックアップ ....
詳細ドロップダウン リスト: ドロップダウンリストを素早く作成する   |  依存関係のドロップダウン リスト   |  複数選択のドロップダウンリスト ....
列マネージャー: 特定の数の列を追加する  |  列の移動  |  Toggle 非表示列の表示ステータス  |  範囲と列の比較 ...
注目の機能: グリッドフォーカス   |  デザインビュー   |   ビッグフォーミュラバー   |  ワークブックとシートマネージャー   |  リソースライブラリ (自動テキスト)   |  日付ピッカー   |  ワークシートを組み合わせる   |  セルの暗号化/復号化   |  リストごとにメールを送信する   |  スーパーフィルター   |   特殊フィルター (太字/斜体/取り消し線をフィルター...) ...
上位 15 のツールセット:  12 テキスト ツール (テキストを追加, 文字を削除する、...）   |   50+ チャート 種類 (ガントチャート、...）   |   40+ 実用的 式 (誕生日に基づいて年齢を計算する、...）   |   19 挿入 ツール (QRコードを挿入, パスから画像を挿入、...）   |   12 変換 ツール (数字から言葉へ, 通貨の換算、...）   |   7 マージ＆スプリット ツール (高度な結合行, 分割セル、...）   |   ... もっと

Kutools for Excel で Excel スキルを強化し、これまでにない効率を体験してください。 Kutools for Excelは、生産性を向上させ、時間を節約するための300以上の高度な機能を提供します。  最も必要な機能を入手するにはここをクリックしてください...

説明

Officeタブは、タブ付きのインターフェイスをOfficeにもたらし、作​​業をはるかに簡単にします

  • Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
  • 新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
  • 生産性を 50% 向上させ、毎日何百回もマウス クリックを減らすことができます!
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