同一フォルダにある複数のテキストファイル（メモ帳）を一括でエクセルに取り込みたいです。

同一フォルダにある複数のテキストファイル（メモ帳）を一括でエクセルに取り込みたいです。

テキストファイルの内容は改行なしの文章です。
エクセルへのまとめ方は

テキストファイル１
テキストファイル２
テキストファイル３

というようにA列に１行２行３行と並んでいくようにまとめたいです。

エクセルのマクロなどでテキストファイルが入っているものを読み込み
エクセルにまとめたいです。

処理する量は３００ファイルをまとめるという作業をしたいです。

No.1 回答者： isoworld 回答日時： 2020/11/28 09:02

メモ帳の内容をコピーして、そのままエクセルの表に貼り付けてはどうでしょうか。

No.2 回答者： めぐみん_ 回答日時： 2020/11/28 09:33

３００ファイルで１ファイルに１行しかないって事かな？

で、３００ファイルの取り込む順番は？ってのが気になる定番事項。
ナンバーリングされているの？

と検証できない初級レベルは思いました。

No.3 回答者： ママチャリ 回答日時： 2020/11/28 10:10

naaa777さんって、VBA書けないんですよね？

であれば、コマンドプロンプトのコピーコマンドを使って、1ファイルに纏めて、それをコピペする方が早いと思いますよ。
コピーコマンドはこんな感じです。

copy *.txt all.txt

No.4 回答者： ggrksdqn 回答日時： 2020/11/28 13:40

'*****************************************************

'メイン
'*****************************************************
Public Sub test()

'テキストファイルが入ったフォルダの親フォルダのパス
Const PARENT_PATH As String = "C:"

'テキストファイルが入ったフォルダの名称
Const FOLDER_NAME As String = "テキストファイル"

'転記先になるシートの名称
Const DEST_WS_NAME As String = "Sheet1"

'転記先の原点になるセルの名称
Const DEST_RANGE_NAME As String = "A1"

'転記先の原点になるセル
Dim orgRange As Range
Set orgRange = ThisWorkbook.Sheets(DEST_WS_NAME).Range(DEST_RANGE_NAME)

'配列を取得する
Dim txt() As String
txt = getTextArray(PARENT_PATH & "\" & FOLDER_NAME)

'配列の要素数だけ繰り返す
Dim i As Long
For i = LBound(txt) To UBound(txt)
'原点になるセルから１行ずつずらしながら
'配列の要素を入力する
orgRange.Offset(i, 0) = txt(i)
Next

End Sub

'*****************************************************
'指定したフォルダ内にあるテキストファイルを
'ひとつずつ開き、含まれるすべての文字列を配列に入れて返す
'引数: テキストファイルが保存されているフォルダーのパス
'戻値: テキストファイルに含まれる文字列を入れた配列
'*****************************************************

Public Function getTextArray(srcFolderPath As String) As String()

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

ReDim ret(0) As String

'フォルダー内にあるファイルの数だけ繰り返す
Dim f As Object
For Each f In fso.GetFolder(srcFolderPath).files

'拡張子が.txt の場合
If f.Name Like "*.txt" Then
'含まれる全てのテキストを配列に入れる
ret(UBound(ret)) = f.OpenAsTextStream.ReadAll
f.OpenAsTextStream.Close
ReDim Preserve ret(UBound(ret) + 1)
End If

Next

ReDim Preserve ret(UBound(ret) - 1)

getTextArray = ret

End Function