excel vbaで複数のｃｓｖファイルの読み込み

質問

100シート分のcsvファイルのデーターを一つずつ読み込んでexcelにコピーして使用してますが莫大な時間がかかって困ってます。
vbaを使用して作業を簡素化出来る事は出来ないでしょうか？
------------------------------------------
※　csvの概要
excelで1枚のcsvファイルを開くとA列の11行目から65536行まで数値データがあります。

※　vbaできたらよいなと思う仕様
そこで、複数のcsvファイルを選択して読み込むとCSV_データと言うSeetのA列の10行目から1枚目のcsvファイル、B列の10行目から2枚目のcsvファイルと言う風に選択した分のcsvを列に続けて数値データを貼り付けしてくれるvbaをご教授していただけると大変助かります。
不躾で申し訳ございませんが宜しくお願い致します。

excel2003
------------------------------------------

回答No.1

merlionXX · ベストアンサー

その100件程度のCSVファイルが入っているフォルダーに以下のマクロを書いたエクセルBOOKを保存してください。（パス取得のため必ず「保存」してください。）
フォルダー内の全てのCSVファイルからA11：A65536のデータをエクセルの.Sheets("CSV_データ")のRange("A10:A65535")から順に転記していきます。（11行目⇒10行目に1行ずらすのは書き間違いではないですよね？）

Sub test01()
Dim MyFile As String, MyPath As String
Dim i As Long
Dim wb As Workbook
MyPath = ThisWorkbook.Path & "\" '自分のパスを取得
MyFile = Dir(MyPath & "*.csv", vbNormal) 'パス内のcsvファイル
Application.ScreenUpdating = False '画面更新停止
Application.Calculation = xlCalculationManual '自動計算停止
Do Until MyFile = "" '対象ファイルがなくなるまで
Set wb = Workbooks.Open(MyPath & "\" & MyFile) '選択したファイルを開く
ThisWorkbook.Sheets("CSV_データ").Range("A10:A65535").Offset(, i).Value = wb.Sheets(1).Range("A11:A65536").Value '転記
i = i + 1 'カウント
wb.Close (False) '選択したファイルを閉じる
MyFile = Dir '次のファイルを検索
If i = 257 Then
MsgBox "列が一杯になりました。", vbCritical, "Σ（￣ロ￣lll) "
Exit Do
End If
Loop '繰り返し
Application.Calculation = xlCalculationAutomatic '自動計算停止解除
Application.ScreenUpdating = True '画面更新停止解除
Set wb = Nothing
MsgBox i & "件のCSVファイルから転記しました。", vbInformation, " " & Environ("UserName") & "さん (o^-')v "
End Sub

お礼

merlionXXさん
ありがとうございます。・・・・・・・・・・感謝
動作確認できました。
今までの労力がうその様です。

本当にありがとうございます。