| |
初めて質問させていただきます。
過去ログがエラーで見られない為、新規投稿させて頂きました。
掲題のような作業をするマクロを作成したいのですが、
サブフォルダを含めるというところで躓いております。
以下、現在のコードです。
Private Sub GetData(ByVal FolderPath As String)
'引数付のサブルーチン
'引数は、フォルダーのパス
Dim FSO As New FileSystemObject
Dim Files As Files
Dim File As File
Dim FileName As String
Dim TenkiRow As Integer
Application.ScreenUpdating = False
'引数のパス内のファイル一覧を取得
Set Files = FSO.GetFolder(FolderPath).Files
For Each File In Files
'フルパスを取得
FileName = FolderPath & "" & File.Name
'ファイルを開く
Workbooks.Open FileName
With ThisWorkbook.Worksheets(1)
'転記先の行を取得
TenkiRow = .Range("B65536").End(xlUp).Offset(1).Row
'転記作業
.Range("A" & TenkiRow).Value = _
ActiveWorkbook.Worksheets(1).Range("C1").Value
.Range("B" & TenkiRow).Value = _
ActiveWorkbook.Worksheets(1).Range("M17").Value
.Range("C" & TenkiRow).Value = _
ActiveWorkbook.Worksheets(1).Range("A9").Value
.Range("D" & TenkiRow).Value = _
ActiveWorkbook.Worksheets(1).Range("F9").Value
.Range("E" & TenkiRow).Value = _
ActiveWorkbook.Worksheets(1).Range("L2").Value
.Range("F" & TenkiRow).Value = _
ActiveWorkbook.Worksheets(1).Range("C30").Value
End With
'ファイルを閉じる
ActiveWorkbook.Close False
Next
Application.ScreenUpdating = True
End Sub
Sub ファイルの取得()
'サブルーチンを使って、
'指定フォルダ内のファイルの値を転記する
Dim MyPath As String
'変数に、フォルダのパスを代入
MyPath = "C:\Users\親フォルダのパスを記載しています。"
'サブルーチンの呼び出し
GetData MyPath
End Sub
具体的な訂正箇所、追記などご教示頂けますと非常に
助かります。
よろしくお願い申し上げます。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
