ExcelのVBAに関して教えてください。

質問

下記のようにCSVファイル名を複数入力してマクロ実行したら転記するようにしたいです。
やり方がわかる人いたら、教えてください。

(1)C10にa、C11にb、C12にc、C13にdを入力
(2)マクロ実行ボタンを押す
(3)aのcsvファイルのG12～G36をD10～D34に転記。 ※aのパスは¥¥mm¥nn¥cc¥a.csv
　bのcsvファイルのG12～G36をD35～D59に転記。 ※bのパスは¥¥mm¥nn¥yy¥b.csv
　cのcsvファイルのG12～G36をD60～D84に転記。 ※cのパスは¥¥mm¥nn¥kk¥c.csv
　dのcsvファイルのG12～G36D85～D109にを転記。※dのパスは¥¥mm¥nn¥bb¥d.csv

　難しい点は最下層のフォルダが異なっている点です。。
　最下層のフォルダ違うが、csvファイルを転記する方法はありませんか？

回答No.3

watabe007

Sub Test2()
Dim FSO As Object, myPath As String, strText As String
Dim c As Range, buf As Variant
Dim i As Long, j As Long, sr As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
j = 10
For Each c In Range("C10", Cells(Rows.Count, "C").End(xlUp))
myPath = GetPath("\\mm\nn", c.Value & ".csv")
If myPath <> "" Then
With FSO.OpenTextFile(myPath, 1)
buf = .ReadAll
.Close
End With
buf = Split(buf, vbCrLf)
For i = 11 To 35
strText = Split(buf(i), ",")(6)
Cells(sr + j, "D").Value = strText
j = j + 1
Next
End If
Next
Set FSO = Nothing
End Sub
Function GetPath(Path As String, Target As String)
Dim FSO As Object, Folder As Variant, File As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Folder In FSO.GetFolder(Path).SubFolders
For Each File In Folder.Files
If File.Name = Target Then
GetPath = File.Path
Exit Function
End If
Next
Next
GetPath = ""
Set FSO = Nothing
End Function

回答No.2

watabe007

参考に
Sub Test()
　　Dim FSO As Object, myPath As String, strText As String
　　Dim myRng As Range, c As Range, buf As Variant
　　Dim i As Long, j As Long, sr As Long

　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　Set myRng = ActiveSheet.Columns("C:C").SpecialCells(xlCellTypeConstants)
　　For Each c In myRng
　　　　If c.Value Like "[a-d]" Then
　　　　　　Select Case c.Value
　　　　　　　　Case "a": sr = 10: myPath = "\\mm\nn\cc\a.csv"
　　　　　　　　Case "b": sr = 35: myPath = "\\mm\nn\yy\b.csv"
　　　　　　　　Case "c": sr = 60: myPath = "\\mm\nn\kk\c.csv"
　　　　　　　　Case "d": sr = 85: myPath = "\\mm\nn\bb\d.csv"
　　　　　　End Select
　　　　　　With FSO.OpenTextFile(myPath, 1)
　　　　　　　　buf = .ReadAll
　　　　　　　　.Close
　　　　　　End With
　　　　　　buf = Split(buf, vbCrLf)
　　　　　　j = 0
　　　　　　For i = 11 To 35
　　　　　　　　strText = Split(buf(i), ",")(6)
　　　　　　　　Cells(sr + j, "D").Value = strText
　　　　　　　　j = j + 1
　　　　　　Next
　　　　End If
　　Next
　　Set FSO = Nothing
End Sub

補足

すみません。説明不足でした。
csvファイルは多数存在していて、e.csvやf.csvなども転記できる形にしたいです。
最下層のcsvファイルを取得するマクロなどはないでしょうか？

回答No.1

SI299792

(1)C10にa、C11にb、C12にc、C13にdを入力
というのは、プログラムで入力ということでしょうか、
それとも、手作業で入力して、そのファイル名でを読み取るということでしょうか。
前者だとします。

＞最下層のフォルダが異なっている
こういう時は、テーブルを作るのが１番手っ取り早い。プログラム上に持つのは面倒です。
まず、新しいワークブックに、"Works" "Table" というシートを作ります（他のシートはいりません）
Table に図のように入力します。
このプログラムを入れ、実行します。
'
Option Explicit
'
Sub Macro1()
'
　　Dim Table As Worksheet
　　Dim Works As Worksheet
　　Dim Row As Integer
　　Dim InputArea As String
　　Dim OutputArea As String
'
'　　Application.ScreenUpdating = False
　　Set Table = Sheets("Table")
　　Set Works = Sheets("Works")
　　Workbooks.Add
'
　　For Row = 2 To Table.[A1].End(xlDown).Row
　　　　Works.Cells.ClearContents
　　　　InputArea = Table.Cells(Row, "A")
　　　　Range(InputArea) = Table.Cells(Row, "B")
　　　　InputArea = Table.Cells(Row, "C")
'
　　　　With Works.QueryTables.Add("TEXT;" & InputArea, Works.[A1])
　　　　　　.RefreshStyle = xlOverwriteCells
　　　　　　.TextFileCommaDelimiter = True
　　　　　　.Refresh False
　　　　End With
　　　　Works.[A1].QueryTable.Delete
　　　　InputArea = Table.Cells(Row, "D")
　　　　OutputArea = Table.Cells(Row, "E")
　　　　Range(OutputArea) = Works.Range(InputArea).Value
　　Next Row
End Sub

補足

すみません。プログラム上で作成は無理でしょうか？
csvファイル名のみ入力してマクロ実行したら、転記できるようにしたいです。またa~d.csv以外にも複数csvファイルがある状況です。