【Excel】フォルダ内に無数のCSVファイルが入っています。ファイル名は不定で、文字コードはSHIFT JISです。

VBA で処理をする例です（とりあえずファイルは消さないようにしました）。

A1セルに対象となるフォルダを入力し

(1) makeFileList を実行します。

　　例 C:\CsvData

A2セルに出力ファイル名（フォルダはA1）を入力し、

(2) makeNewFile を実行します。

　　例 AllData.csv

とした場合、C:\CsvData\AllData.csv に結果が出力されます。

'---------------------------------------------------------------------
' A1 フォルダ下にある CSV ファイルを B列にリストアップ
'---------------------------------------------------------------------
Sub makeFileList()
'-----------------------------------------------------------
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
'--- フォルダの有無のチェック
    If fso.FolderExists(Range("A1").Value) = False Then
        MsgBox "フォルダ[" & Range("A1").Value & "]がありません。"
        Exit Sub
    End If

'--- B列のクリア
    Columns("B").Clear

    Dim file As Object
    Dim lineNum As Long
    lineNum = 1
    For Each file In fso.getFolder(Range("A1").Value).Files
'--- CSVファイルの判定
        If InStr(UCase(file.Name), ".CSV") > 0 Then
            Cells(lineNum, "B").Value = file.Name
            lineNum = lineNum + 1
        End If
    Next
End Sub

'---------------------------------------------------------------------
' B列にあるファイルを規則にしたがって A2 ファイル（パスは A1）に出力
'---------------------------------------------------------------------
Sub makeNewFile()
'-----------------------------------------------------------
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim lastLine As Long
    lastLine = Range("B" & Rows.Count).End(xlUp).Row

'--- 出力ファイルをオープン
    Dim filePath As String
    filePath = Range("A1").Value & "\" & Range("A2").Value
    Dim dstFile As Object
    Set dstFile = fso.CreaTetextFile(filePath, True)
    
    Dim lines As Variant
    lines = Range("B" & Rows.Count).End(xlUp).Row
    Dim ll As Long
    Dim i As Long

    For i = 1 To lines
'--- 各CSVファイルを処理
        filePath = Range("A1").Value & "\" & Cells(i, "B").Value
        lines = Split(fso.OpenTextFile(filePath).ReadAll(), vbNewLine)
        For ll = 3 To UBound(lines) - 3 Step 3
'--- 各行を処理
            dstFile.WriteLine _
                """[" & lines(ll) & "]""," _
                & """" & lines(ll + 1) & """," _
                & lines(ll + 2)
        Next
    Next
    dstFile.Close
End Sub

（１）csvファイルをダブルクリックして、エクセルで読み込む。

「新規ﾃｷｽﾄ文」というシートに読み込まれたものとして、以下、解説します。

（２）シートを追加する。

シート名のタブを右クリック→[挿入]をクリック→ワークシートが選択されているのを確認→[OK]をクリック

「Sheet1」というシートが追加されたものとして、以下、解説します。

（３）Sheet1のA1セルに、次の式を入力する。

=MID(OFFSET(新規ﾃｷｽﾄ文!$A$1,3*ROW(),0),2,FIND("]",新規ﾃｷｽﾄ文!$A$1)-2)

（４）Sheet1のB1セルに、次の式を入力する。

=OFFSET(新規ﾃｷｽﾄ文!$A$1,3*ROW()+1,0)

（５）Sheet1のC1セルに、次の式を入力する。

=OFFSET(新規ﾃｷｽﾄ文!$A$1,3*ROW()+1,4)

（６）範囲A1:C1を必要なだけ下にコピーして下さい。

※コピーのやり方

囲A1:C1をマウスで選択すると、太い線の四角で囲まれる。→その四角の右下の角を下にドラッグするとコピーされます。

（７）式を値に変換する。

データが表示された範囲を全て選択→右クリック→コピー→右クリック→形式を選択して貼り付け→[値]をチェック→[OK]

（８）「新規ﾃｷｽﾄ文」というシートを削除し、このブックを保存して完成。

以上です。

失礼しました。

仕様を読み間違えてましたね。

日本語の説明内に「, 」がないことが前提ですが、処理の部分を下記に置き換えてみてどうでしょうか。

    Dim words As Variant
    For i = 1 To lines
'--- 各CSVファイルを処理
        filePath = Range("A1").Value & "\" & Cells(i, "B").Value
        lines = Split(fso.OpenTextFile(filePath).ReadAll(), vbNewLine)
        For ll = 3 To UBound(lines) - 3 Step 3
'--- 各行を処理
            words = Split( lines(ll + 1), "," )
            dstFile.WriteLine _
                """[" & lines(ll) & "]""," _
                & """" & words(0) & """," _
                & words(4)
        Next
    Next

説明内に「,」がある場合は、別の方法が必要ですのでコメントください。

たびたび失礼しました。

1行目の処理が、まだ仕様通りでは無いですね。

lastLine も正しく使われていなかったので、全体を修正して再掲しました。

こちらでどうでしょうか。

'---------------------------------------------------------------------
' A1 フォルダ下にある CSV ファイルを B列にリストアップ
'---------------------------------------------------------------------
Sub makeFileList()
'-----------------------------------------------------------
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
'--- フォルダの有無のチェック
    If fso.FolderExists(Range("A1").Value) = False Then
        MsgBox "フォルダ[" & Range("A1").Value & "]がありません。"
        Exit Sub
    End If

'--- B列のクリア
    Columns("B").Clear

    Dim file As Object
    Dim lineNum As Long
    lineNum = 1
    For Each file In fso.getFolder(Range("A1").Value).Files
'--- CSVファイルの判定
        If InStr(UCase(file.Name), ".CSV") > 0 Then
            Cells(lineNum, "B").Value = file.Name
            lineNum = lineNum + 1
        End If
    Next
End Sub

'---------------------------------------------------------------------
' B列にあるファイルを規則にしたがって A2 ファイル（パスは A1）に出力
'---------------------------------------------------------------------
Sub makeNewFile()
'-----------------------------------------------------------
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim lastLine As Long
    lastLine = Range("B" & Rows.Count).End(xlUp).Row

'--- 出力ファイルをオープン
    Dim filePath As String
    filePath = Range("A1").Value & "\" & Range("A2").Value
    Dim dstFile As Object
    Set dstFile = fso.CreaTetextFile(filePath, True)
    
    Dim ll As Long
    Dim i As Long

    Dim dataLines As Variant
    Dim data1 As String
    Dim words As Variant
    For i = 1 To lastLine
'--- 各CSVファイルを処理
        filePath = Range("A1").Value & "\" & Cells(i, "B").Value
        dataLines = Split(fso.OpenTextFile(filePath).ReadAll(), vbNewLine)
        For ll = 3 To UBound(dataLines) - 3 Step 3
'--- 各行を処理
            data1 = Replace(Left(dataLines(ll), InStr(dataLines(ll), "]") - 1), "[", "")
            words = Split(dataLines(ll + 1), ",")
            dstFile.WriteLine _
                """" & data1 & """," _
                & """" & words(0) & """," _
                & words(4)
        Next
    Next
    dstFile.Close
End Sub