Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6996 / 76736

←次へ　｜　前へ→


	【75335】サブフォルダを含めた複数ブックのデータを別ブックに転記する

おっさんそし - 14/2/13(木) 11:19 -


	引用なし

	パスワード

初めて質問させていただきます。
過去ログがエラーで見られない為、新規投稿させて頂きました。

掲題のような作業をするマクロを作成したいのですが、
サブフォルダを含めるというところで躓いております。

以下、現在のコードです。

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

具体的な訂正箇所、追記などご教示頂けますと非常に
助かります。

よろしくお願い申し上げます。

0 hits

▼

【75335】サブフォルダを含めた複数ブックのデータを別ブックに転記する おっさんそし 14/2/13(木) 11:19

≪