複数のtxtの特定部分を抽出し、一つのxlsファイルにまとめたいです。

質問

複数のtxtの特定部分を抽出し、一つのxlsファイルにまとめたいです。
皆様のお知恵をお借りできませんでしょうか？

現在約1000行からなる同一体裁のtxtファイルを多数所持しております。

中身はタブで区切ってあったので、タブをコンマに変換し、CSVファイルを作りました。
これらのファイルを15～20ファイルごとにフォルダ分けしてあります。
このCSVファイルをエクセルで開いたところ、
うちB601:B802に必要な情報が入っていました。
この情報を以下のような要領で入力したまとめxlsファイルを作りたいです。

A列
1行目　一つ目のCSVのファイル名（フォルダ内のCSVを名前順で並べたときに1番上のもの）
2行目～203行目　一つ目のCSVのファイルのB601:B802

B列
1行目　２つ目のCSVのファイル名（名前順で２番目のもの）
2行目～203行目　２つ目のCSVのファイルのB601:B802

（以後15～20ファイル分、O～T列まで。20ファイル以上にも対応できると嬉しいです。）

このxlsファイルを最低でも20個作る予定です。

VBAマクロできっと出来るはずと思い、昨日９時間ほど調べたのですが、習得には至ってません。
例えば１つのCSVのB601:B802をコピーするマクロは作成できますが、
それをまとめファイルのA2に貼り付け、
まとめファイルのA1にCSVのファイル名を挿入し、
さらに同様の抽出をフォルダ内の別のファイルに連続して行い、
挿入部位が被らないようにまとめファイルB列以降に貼り付けさせることができません。

http://www.asahi-net.or.jp/~zn3y-ngi/YNxv252.htmlや
http://oshiete1.goo.ne.jp/kotaeru.php3?q=359726や
http://www.excel.studio-kazu.jp/kw/20080428180002.htmlなどを
応用できないか試してみましたが結局よくわからない状態です。
おそらくこちらの説明が不十分で答えにくい質問なのではないかと思いますが、
どなたかお答えいただければ幸いです。

また、勉強してから出直せ！的なことであれば勉強したいとおもいますので、
お勧めの書籍、サイトを教えていただければ幸いです。
どうかよろしくお願いいたします。

回答No.1

mo2yakko · ベストアンサー

処理する順番が決っていないのでしたら
DIR関数とループを上手く使えば良いかもです。
（手抜きなサンプルですが）
strFileName = Dir("C:\TEMP\*.CSV", vbNormal)
i = 0
Do While strFileName <> ""
　'ファイル開く(省略　※エラーなら抜けないとですが)
　'コピー（省略）

　'ペースト
　Sheets("コピー先").range("A2").offset(0,i).pastespecial
　i = i + 1

　'次のファイル名
　strFileName = Dir()
Loop

決っていないなら
iColumn = .Cells(iRows, .Columns.Count).End(xlToLeft).Column
if .Cells(1,iColumn) = "" then
　iColumn = iColumn + 1
end if
とかでカラム位置を求めるしかないかもです。

お礼

さらにmo2yakkoさんのアドバイスを取り入れた結果、
なんとか狙い通りのマクロを組むことが出来ました！
本当にありがとうございます！

補足

ありがとうございます！

実は質問の後、http://www.moug.net/tech/exvba/0060001.htmを参照して
自分なりに作ってみましたが、動きません。
（エラーもはき出さず、白紙のエクセルのまま。）
正直どこがダメなのか、皆目検討がつきません。
mo2yakkoさんのアドバイスをどのように生かせばよいのかもわかりません。
どなたかご教授願えませんでしょうか？

Sub sample()
　Dim myPath As String
　Dim myFName As String
　Dim FCnt As Integer

　ThisWorkbook.Activate '使うブックをアクティブに
　myPath = ActiveWorkbook.Path 'そのパスを定義
　ChDir myPath 'そのパスのフォルダに移動

　FCnt = 0 '取得ブック数をカウントするための変数を初期化
　myFName = Dir("*.csv") 'Dir関数で最初のファイルを選択

　If myFName <> "" Then 'ブックが取得できた場合
　　FCnt = FCnt + 1 'カウントをプラス
　　Workbooks.Open Filename:=myFName 'ファイルオープン
　　Range("B601:B802").Copy '必要部分のコピー
　　ActiveWorkbook.Close 'データファイルを閉じる
　　ThisWorkbook.Activate 'まとめブックをアクティブに
　　Cells(1, FCnt).Value = myFName 'まとめ一行目にファイル名を挿入
　　Range(Cells(2, FCnt), Cells(6002, FCnt)).PasteSpecial Paste:=xlPasteValues '二行目から値のみ貼り付け（一つのデータ終了）

　　Do
　　　myFName = Dir("*.xls") 'Dir関数で次のファイルを選択
　　　If myFName <> "" Then 'ブックが取得できた場合
　　　FCnt = FCnt + 1 'カウントをプラス
　　　Workbooks.Open Filename:=myFName 'ファイルオープン
　　　Range("B601:B802").Copy '必要部分のコピー
　　　ActiveWorkbook.Close 'データファイルを閉じる
　　　ThisWorkbook.Activate 'まとめブックをアクティブに
　　　Cells(1, FCnt).Value = myFName 'まとめ一行目にファイル名を挿入
　　　Range(Cells(2, FCnt), Cells(6002, FCnt)).PasteSpecial Paste:=xlPasteValues '二行目から値のみ貼り付け（一つのデータ終了）
　　　Else
　　　Exit Do
　　End If
　　Loop
　End If
End Sub