ｴｸｾﾙﾏｸﾛでCSVﾌｧｲﾙを作成するﾏｸﾛの記述について教えてください｡
要望通りのご回答をくださったかたには300ﾎﾟｲﾝﾄ差し上げます｡

【やりたいこと】
異なるﾌｧｲﾙ名のｴｸｾﾙﾌｧｲﾙがあるﾌｫﾙﾀﾞに複数保存されていて､そのすべてのﾌｧｲﾙに含まれる｢sheet1｣ｼｰﾄのF1ｾﾙ､G1ｾﾙ､H1ｾﾙ､I1ｾﾙ､J1ｾﾙの値(但し､F1とJ1はﾌﾞﾗﾝｸの場合もある)を､別ｴｸｾﾙﾌｧｲﾙ(ﾏｸﾛが登録されているﾌｧｲﾙ)の｢sheet2｣のA列,B列,C列,D列,E列にｺﾋﾟｰ&ﾍﾟｰｽﾄし､｢sheet2｣をCSVﾌｧｲﾙでﾃﾞｽｸﾄｯﾌﾟに保存したい｡

【留意事項】
(1)すべてのﾌｧｲﾙにおいて､F1とJ1がﾌﾞﾗﾝｸのｹｰｽもある｡
(2)F1?J1はすべて文字列｡
(3)最終的に完成するCSVﾌｧｲﾙはﾃｷｽﾄで開くと次のような形になる｡
(G1は半角3文字､H1は半角7文字,I1は半角7文字固定)
,aaa,bbbbbbb,ccccccc,,
,ddd,eeeeeee,fffffff,,
,ggg,hhhhhhh,iiiiiii,,

いろいろ調べて作成しているものの､うまくいかずに戸惑っています｡
よろしくお願いいたします｡

一応仕様に沿って作成しましたが､(3) の解釈が不明です｡

元のﾃﾞｰﾀが3(7)文字以上あって規定文字数に詰めるのか(その場合右詰？左詰？)

あるいは足りない場合があり､ｽﾍﾟｰｽ等でﾊﾟﾃﾞｨﾝｸﾞするのか｡

今回は後者で作成しています｡

'--- 収集するEXCEL ﾌｧｲﾙのあるﾊﾟｽ
Const DataFolder = "C:\Data"

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

'--- 自ﾌﾞｯｸに Sheet2 があることが前提
 Dim r As Long
 Dim dstWS As Worksheet
 Set dstWS = ThisWorkbook.Worksheets("Sheet2")
 
'--- ｼｰﾄは Sheet1 でなく1ｼｰﾄ目を指定：Sheet1 とする場合は
'--- Worksheets(1) を Worksheets("Sheet1") に変更｡
 Dim cFile As Object
 For Each cFile In fso.getFolder(DataFolder).Files
 If LCase(fso.GetExtensionName(cFile.Path)) = "xls" Then
 r = r + 1
 With Workbooks.Open(cFile.Path)
 dstWS.Cells(r, "A") = .Worksheets(1).Range("F1")
 dstWS.Cells(r, "B") = Right(" " & .Worksheets(1).Range("G1"), 3)
 dstWS.Cells(r, "C") = Right(" " & .Worksheets(1).Range("H1"), 7)
 dstWS.Cells(r, "D") = Right(" " & .Worksheets(1).Range("I1"), 7)
 dstWS.Cells(r, "E") = .Worksheets(1).Range("J1")
 .Close
 End With
 End If
 Next
 
'--- とりあえずﾌｧｲﾙ名は 日付_時間.csv
 Dim Path As String
 dstWS.Copy
 Path = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\" & Format(Date, "YYYYMMDD") & "_" & Format(Time, "HHMMSS") & ".csv"
 ActiveWorkbook.SaveAs Filename:=Path, FileFormat:=xlCSV
 ActiveWorkbook.Close
End Sub

不明な点や､仕様の解釈の違いがある場合ｺﾒﾝﾄに手対応いたしますので､有効にお願いします｡

お望みのﾏｸﾛは下記を参照されるとよろしいでしょう｡

(ほぼｺﾋﾟﾍﾟで終わります｡)

http://makotowatana.ld.infoseek.co.jp/vba_file2.html

具体的に作ろうかと思ったのですが､不明点がいろいろあります｡

(1)CSVのようでCSVではない｡

ｽﾀｰﾄとｴﾝﾄﾞをｶﾝﾏにするというのは範囲内だと思いますが､

相手先に固定長で取り込ませたい場合は文字列をﾀﾞﾌﾞﾙｸｫｰﾄで囲まなければなりませんし､

Excelのcsv出力を用いる場合は､先頭の半角ｽﾍﾟｰｽは残らなかったりするので､

お望みのものは固定長ﾃｷｽﾄ形式で作成し､拡張子だけをcsvにするという事になります｡

お手軽な方法としては｢A列,B列,C列,D列,E列にｺﾋﾟｰ&ﾍﾟｰｽﾄ｣ではなく

｢A列,B列,C列,D列,E列をｺﾋﾟｰ&出力用に1つにまとめたものをA列にﾍﾟｰｽﾄ｣という形にして､

固定長ﾃｷｽﾄとして出力するのが楽でしょう｡

(2)あるﾌｫﾙﾀﾞに保存されているbook全てが対象？それとも一部？

ﾏｸﾛを記述してあるbookも｢あるﾌｫﾙﾀﾞ｣内にある場合は､自身を開こうとしないようにする条件分岐が入ります｡

(3)どうしてもﾃﾞｽｸﾄｯﾌﾟ？

ﾃﾞｽｸﾄｯﾌﾟﾌｫﾙﾀﾞの位置はOSやﾕｰｻﾞｰ環境によって変わる場合があり､ﾌﾟﾛｸﾞﾗﾑ難易度があがります｡

ｴｸｾﾙのﾌﾞｯｸ､ｼｰﾄは｢CSV形式で保存する｣ということができるのでこれを使えば大丈夫だと思います｡

下記にｺｰﾄﾞを示します｡

参照設定で

･Microsoft Scripting Runtime

･Windows Script Host Object Model

の2つを参照設定(ﾒﾆｭｰの｢ﾃﾞｰﾀ｣から｢参照設定｣)しておかないと動きませんが､参照設定しておくと便利です｡

ﾃﾞｰﾀｺﾋﾟｰ先は､Sheet2の末端にｺﾋﾟｰし､実行後の状態を保持します｡

Sub main()
 
 Dim FSO As Scripting.FileSystemObject
 Dim F As File
 Dim WSH As WshShell

' Dim FSO As Object
' Dim F As Object
' Dim WSH As Object
 
 Dim WB As Workbook
 Dim ShtDst As Worksheet
 Dim RngDst As Range
 
 Set FSO = CreateObject("Scripting.FileSystemObject")
 
 '各ﾌｫﾙﾀﾞ名､ﾌｧｲﾙ名設定
 rootFldrPath = ThisWorkbook.Path
 SrcFldrName = "data"
 SrcFldrPath = rootFldrPath & "\" & SrcFldrName
 
 Set WSH = CreateObject("Wscript.Shell")
 dstFldrPath = WSH.SpecialFolders("Desktop")
 dstFilePath = dstFldrPath & "\" & "data" & Format(Now, "yyyymmdd_hhmmss") & ".csv"
 
 'ﾃﾞｰﾀｺﾋﾟｰ先取得
 Set ShtDst = ThisWorkbook.Sheets("Sheet2")
 With ShtDst.Cells.SpecialCells(xlCellTypeLastCell)
 If .Row = 1 And .Column = 1 Then
 lastRow = 0
 Else
 lastRow = ShtDst.Cells.SpecialCells(xlCellTypeLastCell).Row
 End If
 End With
 
 '指定したﾌｫﾙﾀﾞ内の全ﾌｧｲﾙ(拡張子が｢.xls｣か｢.xlsx｣のもの)からﾃﾞｰﾀ取得
 For Each F In FSO.GetFolder(SrcFldrPath).Files
 If LCase(F.Name) Like "*.xls" Or LCase(F.Name) Like "*.xlsx" Then
 lastRow = lastRow + 1
 Set WB = Workbooks.Open(SrcFldrPath & "\" & F.Name)
 ShtDst.Cells(lastRow, 1).Resize(1, 5).Value = WB.Sheets("Sheet1").Cells(1, 6).Resize(1, 5).Value
 WB.Close False
 End If
 Next
 
 '｢Sheet2｣を新しいﾌﾞｯｸにｺﾋﾟｰ
 ShtDst.Copy
 Set WBtmp = ActiveWorkbook
 
 'CSVで保存して閉じる
 WBtmp.SaveAs dstFilePath, xlCSV
 WBtmp.Close False
 
End Sub

概ね既に出ている回答でよろしいと思います｡

ただ､一点気になったところがあって､

＞(1)すべてのﾌｧｲﾙにおいて､F1とJ1がﾌﾞﾗﾝｸのｹｰｽもある｡

全てのﾌｧｲﾙのF1かJ1がﾌﾞﾗﾝｸの場合､ExcelをCSVに直接保存すると､

最初と最後のｺﾝﾏが付かないｹｰｽが出てくるので､ﾃｷｽﾄｽﾄﾘｰﾑから保存するようにしました｡

(例ではﾃﾞｰﾀが5つなのでｺﾝﾏが一つ多いようですが､それも考慮しました)

1行目のﾌｧｲﾙの有るﾌｫﾙﾀﾞのﾊﾟｽを変更して実行してみてください｡

Sub Macro()
 Const FoldPath As String = "C:\Documents and Settings\hogehoge\ﾃﾞｽｸﾄｯﾌﾟ\test"
 Dim FSO As Object
 Dim myFile As Object
 Dim ext As String
 Dim r As Long
 Dim TS As Object
 Dim SavePath As String
 Dim WSH As Object
 Dim str As String
 Dim i As Integer
 Dim wb As Workbook
 
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set WSH = CreateObject("Wscript.Shell")
 SavePath = WSH.SpecialFolders("Desktop") & "\result.csv"
 
 Set TS = FSO.CreateTextFile(Filename:=SavePath, Overwrite:=True)
 
 With ThisWorkbook.Worksheets("Sheet2")
 For Each myFile In FSO.GetFolder(FoldPath).Files
 ext = FSO.GetExtensionName(myFile)
 If LCase(ext) = "xls" Or LCase(ext) = "xlsx" Then
 r = r + 1
 Set wb = Workbooks.Open(myFile.Path)
 wb.Worksheets("Sheet1").Range("F1:J1").Copy .Cells(r, 1)
 wb.Close
 str = ""
 For i = 1 To 5
 str = str & .Cells(r, i) & ","
 Next i
 TS.WriteLine str
 End If
 Next
 End With
 
 TS.Close
 Set TS = Nothing
 Set FSO = Nothing
 Set WSH = Nothing
End Sub

(C)株式会社はてな