フォルダ内にあるテキストファイル複数行転記について

質問

Excel VBAにて、フォルダ内のテキストファイルの複数行をExcelに転記するにはどうしたら良いでしょうか。

WEBサイトで似たようなものがありましたが、このマクロは２行目のみの転記です。
実際は14、18、28、32行目を転記したいです。
+αで条件を追加すると以下のようになります。

①フォルダ内には100件近くのテキストファイルがあり、全て順番に処理をしていく
②抽出したい行にはタブで数字が５つほど並んでいます。（画像の用な感じです。）
③28、32行目は転記しデータを区切った後、左側２つの数字は削除したいです。（全てのテキストファイルに適用）
④特に空白行は作らず、下に追加していく。(A1から開始)
⑤シートを新しく追加する。

Excelはo365を使用しています。

参考にしたマクロは以下のものです。
初心者の為、すみませんが教えてください。よろしくお願いします。

********************************************
'指定フォルダの全テキストの任意行を取得
Sub GetAllTextData()

'フォルダ指定用のダイアログを表示します
With Application.FileDialog(msoFileDialogFolderPicker)

'カレントディレクトリを指定します
.InitialFileName = ThisWorkbook.Path

'設定しなかったら終了します
If .Show = False Then Exit Sub

'設定したフォルダを表示します
Dim Fname
Fname = .SelectedItems(1)

End With

'参照設定
Dim FSO As Object, Folder As Variant, File As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")

Dim FilePath As Variant
ReDim FilePath(1 To 100) As Variant

'指定フォルダ内の.txtファイルを探索します
i = 0
For Each File In FSO.GetFolder(Fname).Files
If InStr(File.Name, ".txt") > 0 Then
i = i + 1
FilePath(i) = File.Path 'ファイルのフルパスを取得
End If
Next

'配列の大きさは状況に応じ変更してください
Dim Hozon, GetData As Variant
ReDim GetData(1 To 100, 1 To 100) As Variant

'全テキストファイルの任意行のデータを取得する
m = 0
For k = 1 To UBound(FilePath, 1)

'テキストファイルが存在する場合に実行
If IsEmpty(FilePath(k)) = False Then

'保存する配列を空にする
ReDim Hozon(1 To 100, 1 To 100) As Variant

'テキストを開いて配列にデータを保存
Open FilePath(k) For Input As #1
i = 0
'テキストをすべて取得する
Do Until EOF(1)
Line Input #1, buf
i = i + 1
'コンマ区切りでデータを取得する
a = Split(buf, ",")
For j = 0 To UBound(a, 1)
Hozon(i, j + 1) = a(j)
Next
Loop
Close #1

'▼取得したいデータに応じ変更してください
'任意行の値を取得する
i = 2 '2行目のデータを取得
m = m + 1
For j = 1 To UBound(Hozon, 2)
GetData(m, j) = Hozon(i, j)
Next

End If
Next

'データ貼り付け
With ActiveSheet
.Range(.Cells(2, 1), .Cells(2, 1).Offset(UBound(GetData, 1) - 1, UBound(GetData, 2) - 1)) = GetData
End With

End Sub

（参考サイト：https://daitaideit.com/vba-get-alltext/）

回答No.2

imogasi

フォルダ内にあるテキストファイル複数行転記について
＝＝＞すべてのファイルを対象にするのだね。
Excel VBAにて、フォルダ内のテキストファイルの複数行をExcelに転記するにはどうしたら良いでしょうか。
＝＝＞エクセルVBAを使う、のだね。
１テキストファイルをエクセルシートに読み込むのは、都合が悪いのかな？
そして、望む項目を、エクセルのシートに書き出すのだね。
１テキストファイルあたり抜出該当が、複数行＝複数レコードあるということか？どういう単位で複数行に分けるのか？

①フォルダ内には100件近くのテキストファイルがあり、全て順番に処理をしていく
==>各テキストファイルには、その中に、データ項目のようなものがあって、データ区切り（カンマ、タブ、空白などが多い）はあるのか、無いのか。文章のように文字列、数などが並んでいるのか？

②抽出したい行にはタブで数字が５つほど並んでいます。（画像の用な感じです。）
＝＝＞数字が５つほど、
の「ほど」は扱いづらいのだか、どういう状態か？

③28、32行目は転記しデータを区切った後、左側２つの数字は削除したいです。（全てのテキストファイルに適用）
＝＝＞（全てのテキストファイルに適用）は質問の全文にかかわるのではないのか？
「28、32行目」は検出が難しいのだが。(注１）

④特に空白行は作らず、下に追加していく。(A1から開始)
＝＝＞エクセルシート（決めた１シート）に上の行から行的に、列挙していくということだろうね。書かずもがなと思う。
＞(A1から開始)は、アウトプット行ポインターを使えば、初期値設定によってで、自由に設定できる。

⑤シートを新しく追加する。
コードが出来上がってからでも、簡単に変えられる。

注１）レコード番号を指定してファイルのレコード１つを読むことも、ないではないが、固定長でないと難しいようだ。

回答No.1

SI299792

画像を見る限り、Ａ～Ｅ列を転記すればいいみたいですが、それでもいいですか。
.txt、カンマ区切りですか。
文字コードはシフトジス（Ansi）専用です。
貴方の上げたプログラムは、長く複雑て理解できないので、自作しました。
Option Explicit
'
Sub Macro1()
　　Dim Path As String
　　Dim File As Variant
　　Dim RInp As Long
　　Dim ROut As Long
　　Dim Colu As Integer
'
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.InitialFileName = ThisWorkbook.Path
'
　　　　If .Show = False Then
　　　　　　End
　　　　End If
　　　　Path = .SelectedItems(1)
　　End With
　　File = Dir(Path & "\*.txt")
　　[A:E].ClearContents
　　Application.ScreenUpdating = False
'
　　Do While File > ""
　　　　Open Path & "\" & File For Input As #1
　　　　RInp = 0
'
　　　　Do While Not EOF(1)
　　　　　　RInp = RInp + 1
　　　　　　Line Input #1, File

　　　　　　If RInp = 14 Or RInp = 18 Or RInp = 28 Or RInp = 32 Then
　　　　　　　　File = Split(File, ",")
　　　　　　　　ROut = ROut + 1
'
　　　　　　　　For Colu = 1 To 5
　　　　　　　　　　Cells(ROut, Colu) = File(Colu - 1)
　　　　　　　　Next Colu
　　　　　　End If
　　　　Loop
　　　　Close
　　　　File = Dir
　　Loop
End Sub