エクセルマクロの質問です。

質問

例えば、A.xlsというファイルに01.csv，02.csv，・・・，20.csvといういくつかのファイルからデータを取り出すのですが、A.xlsのシート１の1列目に01.csvの1列目を貼り付けて、01.csvの2列目はA.xlsのシート２の1列目に貼り付けるようにシートをずらして行って、02.csvの1列目はA.xlsのシート１の2列目、02.csvの2列目はA.xlsのシート２の2列目というようにしたいのですが、どのようなプログラムがよいのでしょうか？
エクセルマクロ初心者なので説明が不十分かも知れませんがよろしくお願いします。

回答No.4

DOUGLAS_

[回答番号：No.1] の DOUGLAS_ です。

　列ごとの読み込みでしたね。
　[回答番号：No.1] は、行ごとの読み込みのヒントでした。失礼いたしました。　　<(_ _)>

　ＶＢＡのコード丸出しになりますが、ついでに、行ごとの読み込みの場合もお示ししておきます。
MyPath = "D:\hoge\"
のところで、ＣＳＶファイル の保存されたフォルダのフルパス（最後に「\」マーク）を指定してください。

Sub 列ごとの読み込み()
　Application.ScreenUpdating = False
　　Dim MyPath As String
　　Dim MyFile As String
　　Dim i As Integer
　　Dim LastCol As Integer
　　Dim intCols As Integer
　　ActiveSheet.Name = "ファイル名"
　　MyPath = "D:\hoge\"
　　ChDir MyPath
　　MyFile = Dir(MyPath & "*.CSV")
　　Do While MyFile <> ""
　　　Sheets("ファイル名").Select
　　　LastCol = Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Column
　　　Cells(1, LastCol).Value = Replace(MyFile, ".CSV", "")
　　　Workbooks.Open MyPath & MyFile
　　　intCols = ActiveCell.SpecialCells(xlLastCell).Column
　　　ThisWorkbook.Activate
　　　For i = 1 To intCols
　　　　On Error Resume Next
　　　　　Sheets("" & i).Select
　　　　　If Err.Number <> 0 Then
　　　　　Sheets.Add after:=ActiveSheet, Type:="ワークシート"
　　　　　ActiveSheet.Name = i
　　　　　End If
　　　　On Error GoTo 0
　　　　Workbooks(MyFile).Sheets(Replace(MyFile, ".CSV", "")).Columns(i).Copy _
　　　　ThisWorkbook.Sheets("" & i).Columns(LastCol - 1)
　　　Next
　　　Workbooks(MyFile).Close
　　　MyFile = Dir
　　Loop
　　Sheets("ファイル名").Select
　　Range("A1").Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End Sub

Sub 行ごとの読み込み()
　Application.ScreenUpdating = False
　　Dim MyPath As String
　　Dim MyFile As String
　　Dim EndLineRow As Integer
　　Dim TextLine As Variant
　　Dim i As Integer
　　ActiveSheet.Name = "ファイル名"
　　MyPath = "D:\hoge\"
　　MyFile = Dir(MyPath & "*.CSV")
　　Do While MyFile <> ""
　　　Sheets("ファイル名").Select
　　　EndLineRow = Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
　　　Cells(EndLineRow, 1).Value = Replace(MyFile, ".CSV", "")
　　　Open MyPath & MyFile For Input As #1
　　　Do While Not EOF(1)
　　　　Line Input #1, TextLine
　　　　On Error Resume Next
　　　　　i = i + 1
　　　　　Sheets("" & i).Select
　　　　　If Err.Number <> 0 Then
　　　　　　Sheets.Add after:=ActiveSheet, Type:="ワークシート"
　　　　　　ActiveSheet.Name = i
　　　　　End If
　　　　On Error GoTo 0
　　　　TextLine = Split(TextLine, ",")
　　　　Cells(EndLineRow - 1, 1).Resize(, UBound(TextLine) + 1).Value = TextLine
　　　Loop
　　　Close #1
　　　i = 0
　　　MyFile = Dir
　　Loop
　　Sheets("ファイル名").Select
　　Range("A1").Delete Shift:=xlUp
　Application.ScreenUpdating = True
End Sub